summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGuido Günther <agx@sigxcpu.org>2016-12-23 17:50:00 +0100
committerGuido Günther <agx@sigxcpu.org>2016-12-23 17:50:00 +0100
commit21663262f54cd28092853e67e5eb2a2169e79218 (patch)
tree91742749663c1c901b978e010a59e70788adba88
parente66c65ea4f3b82f4924a8ac3f607de0783daf378 (diff)
Import Upstream version 0.6.1.4
Diffstat
-rw-r--r--.gitignore1
-rw-r--r--MANIFEST2
-rw-r--r--Makefile.in1
-rw-r--r--config.h.in161
-rwxr-xr-xconfigure442
-rw-r--r--configure.ac67
-rw-r--r--contrib/0001-Add-Libvirt.Domain.get_cpu_stats_total.patch249
-rw-r--r--examples/.depend14
-rw-r--r--examples/Makefile.in13
-rw-r--r--examples/domain_events.ml145
-rw-r--r--examples/get_cpu_stats.ml2
-rw-r--r--libvirt/.depend12
-rwxr-xr-xlibvirt/generator.pl226
-rw-r--r--libvirt/libvirt.ml775
-rw-r--r--libvirt/libvirt.mli390
-rw-r--r--libvirt/libvirt_c.c617
-rw-r--r--libvirt/libvirt_c_epilogue.c20
-rw-r--r--libvirt/libvirt_c_oneoffs.c625
-rw-r--r--libvirt/libvirt_c_prologue.c42
19 files changed, 2183 insertions, 1621 deletions
diff --git a/.gitignore b/.gitignore
index 2b5e4fd..71a245e 100644
--- a/.gitignore
+++ b/.gitignore
@@ -26,6 +26,7 @@ core.*
*.exe
*~
libvirt/libvirt_version.ml
+examples/domain_events
examples/get_cpu_stats
examples/list_domains
examples/node_info
diff --git a/MANIFEST b/MANIFEST
index 919f3de..b4f75d4 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -7,7 +7,9 @@ config.sub
configure.ac
COPYING
COPYING.LIB
+contrib/0001-Add-Libvirt.Domain.get_cpu_stats_total.patch
examples/.depend
+examples/domain_events.ml
examples/get_cpu_stats.ml
examples/list_domains.ml
examples/node_info.ml
diff --git a/Makefile.in b/Makefile.in
index c0622cc..3b8b7ec 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -40,6 +40,7 @@ clean:
rm -f examples/list_domains
rm -f examples/node_info
rm -f examples/get_cpu_stats
+ rm -f examples/domain_events
distclean: clean
rm -f config.h config.log config.status configure
diff --git a/config.h.in b/config.h.in
index fccbbe7..c0bd102 100644
--- a/config.h.in
+++ b/config.h.in
@@ -30,167 +30,6 @@
/* Define to 1 if you have the <unistd.h> header file. */
#undef HAVE_UNISTD_H
-/* Define to 1 if you have the `virConnectGetHostname' function. */
-#undef HAVE_VIRCONNECTGETHOSTNAME
-
-/* Define to 1 if you have the `virConnectGetURI' function. */
-#undef HAVE_VIRCONNECTGETURI
-
-/* Define to 1 if you have the `virConnectListDefinedStoragePools' function.
- */
-#undef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS
-
-/* Define to 1 if you have the `virConnectListStoragePools' function. */
-#undef HAVE_VIRCONNECTLISTSTORAGEPOOLS
-
-/* Define to 1 if you have the `virConnectNumOfDefinedStoragePools' function.
- */
-#undef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS
-
-/* Define to 1 if you have the `virConnectNumOfStoragePools' function. */
-#undef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS
-
-/* Define to 1 if you have the `virDomainBlockPeek' function. */
-#undef HAVE_VIRDOMAINBLOCKPEEK
-
-/* Define to 1 if you have the `virDomainBlockStats' function. */
-#undef HAVE_VIRDOMAINBLOCKSTATS
-
-/* Define to 1 if you have the `virDomainGetCPUStats' function. */
-#undef HAVE_VIRDOMAINGETCPUSTATS
-
-/* Define to 1 if you have the `virDomainGetSchedulerParameters' function. */
-#undef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
-
-/* Define to 1 if you have the `virDomainGetSchedulerType' function. */
-#undef HAVE_VIRDOMAINGETSCHEDULERTYPE
-
-/* Define to 1 if you have the `virDomainInterfaceStats' function. */
-#undef HAVE_VIRDOMAININTERFACESTATS
-
-/* Define to 1 if you have the `virDomainMemoryPeek' function. */
-#undef HAVE_VIRDOMAINMEMORYPEEK
-
-/* Define to 1 if you have the `virDomainMigrate' function. */
-#undef HAVE_VIRDOMAINMIGRATE
-
-/* Define to 1 if you have the `virDomainSetSchedulerParameters' function. */
-#undef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
-
-/* Define to 1 if you have the `virNodeGetCellsFreeMemory' function. */
-#undef HAVE_VIRNODEGETCELLSFREEMEMORY
-
-/* Define to 1 if you have the `virNodeGetFreeMemory' function. */
-#undef HAVE_VIRNODEGETFREEMEMORY
-
-/* Define to 1 if you have the `virStoragePoolBuild' function. */
-#undef HAVE_VIRSTORAGEPOOLBUILD
-
-/* Define to 1 if you have the `virStoragePoolCreate' function. */
-#undef HAVE_VIRSTORAGEPOOLCREATE
-
-/* Define to 1 if you have the `virStoragePoolCreateXML' function. */
-#undef HAVE_VIRSTORAGEPOOLCREATEXML
-
-/* Define to 1 if you have the `virStoragePoolDefineXML' function. */
-#undef HAVE_VIRSTORAGEPOOLDEFINEXML
-
-/* Define to 1 if you have the `virStoragePoolDelete' function. */
-#undef HAVE_VIRSTORAGEPOOLDELETE
-
-/* Define to 1 if you have the `virStoragePoolDestroy' function. */
-#undef HAVE_VIRSTORAGEPOOLDESTROY
-
-/* Define to 1 if you have the `virStoragePoolFree' function. */
-#undef HAVE_VIRSTORAGEPOOLFREE
-
-/* Define to 1 if you have the `virStoragePoolGetAutostart' function. */
-#undef HAVE_VIRSTORAGEPOOLGETAUTOSTART
-
-/* Define to 1 if you have the `virStoragePoolGetConnect' function. */
-#undef HAVE_VIRSTORAGEPOOLGETCONNECT
-
-/* Define to 1 if you have the `virStoragePoolGetInfo' function. */
-#undef HAVE_VIRSTORAGEPOOLGETINFO
-
-/* Define to 1 if you have the `virStoragePoolGetName' function. */
-#undef HAVE_VIRSTORAGEPOOLGETNAME
-
-/* Define to 1 if you have the `virStoragePoolGetUUID' function. */
-#undef HAVE_VIRSTORAGEPOOLGETUUID
-
-/* Define to 1 if you have the `virStoragePoolGetUUIDString' function. */
-#undef HAVE_VIRSTORAGEPOOLGETUUIDSTRING
-
-/* Define to 1 if you have the `virStoragePoolGetXMLDesc' function. */
-#undef HAVE_VIRSTORAGEPOOLGETXMLDESC
-
-/* Define to 1 if you have the `virStoragePoolListVolumes' function. */
-#undef HAVE_VIRSTORAGEPOOLLISTVOLUMES
-
-/* Define to 1 if you have the `virStoragePoolLookupByName' function. */
-#undef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME
-
-/* Define to 1 if you have the `virStoragePoolLookupByUUID' function. */
-#undef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID
-
-/* Define to 1 if you have the `virStoragePoolLookupByUUIDString' function. */
-#undef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING
-
-/* Define to 1 if you have the `virStoragePoolLookupByVolume' function. */
-#undef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME
-
-/* Define to 1 if you have the `virStoragePoolNumOfVolumes' function. */
-#undef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES
-
-/* Define to 1 if the system has the type `virStoragePoolPtr'. */
-#undef HAVE_VIRSTORAGEPOOLPTR
-
-/* Define to 1 if you have the `virStoragePoolRefresh' function. */
-#undef HAVE_VIRSTORAGEPOOLREFRESH
-
-/* Define to 1 if you have the `virStoragePoolSetAutostart' function. */
-#undef HAVE_VIRSTORAGEPOOLSETAUTOSTART
-
-/* Define to 1 if you have the `virStoragePoolUndefine' function. */
-#undef HAVE_VIRSTORAGEPOOLUNDEFINE
-
-/* Define to 1 if you have the `virStorageVolCreateXML' function. */
-#undef HAVE_VIRSTORAGEVOLCREATEXML
-
-/* Define to 1 if you have the `virStorageVolDelete' function. */
-#undef HAVE_VIRSTORAGEVOLDELETE
-
-/* Define to 1 if you have the `virStorageVolFree' function. */
-#undef HAVE_VIRSTORAGEVOLFREE
-
-/* Define to 1 if you have the `virStorageVolGetInfo' function. */
-#undef HAVE_VIRSTORAGEVOLGETINFO
-
-/* Define to 1 if you have the `virStorageVolGetKey' function. */
-#undef HAVE_VIRSTORAGEVOLGETKEY
-
-/* Define to 1 if you have the `virStorageVolGetName' function. */
-#undef HAVE_VIRSTORAGEVOLGETNAME
-
-/* Define to 1 if you have the `virStorageVolGetPath' function. */
-#undef HAVE_VIRSTORAGEVOLGETPATH
-
-/* Define to 1 if you have the `virStorageVolGetXMLDesc' function. */
-#undef HAVE_VIRSTORAGEVOLGETXMLDESC
-
-/* Define to 1 if you have the `virStorageVolLookupByKey' function. */
-#undef HAVE_VIRSTORAGEVOLLOOKUPBYKEY
-
-/* Define to 1 if you have the `virStorageVolLookupByName' function. */
-#undef HAVE_VIRSTORAGEVOLLOOKUPBYNAME
-
-/* Define to 1 if you have the `virStorageVolLookupByPath' function. */
-#undef HAVE_VIRSTORAGEVOLLOOKUPBYPATH
-
-/* Define to 1 if the system has the type `virStorageVolPtr'. */
-#undef HAVE_VIRSTORAGEVOLPTR
-
/* Define to 1 if your C compiler doesn't accept -c and -o together. */
#undef NO_MINUS_C_MINUS_O
diff --git a/configure b/configure
index 8510e38..dfeb84c 100755
--- a/configure
+++ b/configure
@@ -1,11 +1,9 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.68 for ocaml-libvirt 0.6.1.2.
+# Generated by GNU Autoconf 2.69 for ocaml-libvirt 0.6.1.4.
#
#
-# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
-# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software
-# Foundation, Inc.
+# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
@@ -134,6 +132,31 @@ export LANGUAGE
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
+# Use a proper internal environment variable to ensure we don't fall
+ # into an infinite loop, continuously re-executing ourselves.
+ if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
+ _as_can_reexec=no; export _as_can_reexec;
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+as_fn_exit 255
+ fi
+ # We don't want this to propagate to other subprocesses.
+ { _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
@@ -167,7 +190,8 @@ if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
else
exitcode=1; echo positional parameters were not saved.
fi
-test x\$exitcode = x0 || exit 1"
+test x\$exitcode = x0 || exit 1
+test -x / || exit 1"
as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
@@ -212,21 +236,25 @@ IFS=$as_save_IFS
if test "x$CONFIG_SHELL" != x; then :
- # We cannot yet assume a decent shell, so we have to provide a
- # neutralization value for shells without unset; and this also
- # works around shells that cannot unset nonexistent variables.
- # Preserve -v and -x to the replacement shell.
- BASH_ENV=/dev/null
- ENV=/dev/null
- (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
- export CONFIG_SHELL
- case $- in # ((((
- *v*x* | *x*v* ) as_opts=-vx ;;
- *v* ) as_opts=-v ;;
- *x* ) as_opts=-x ;;
- * ) as_opts= ;;
- esac
- exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"}
+ export CONFIG_SHELL
+ # We cannot yet assume a decent shell, so we have to provide a
+# neutralization value for shells without unset; and this also
+# works around shells that cannot unset nonexistent variables.
+# Preserve -v and -x to the replacement shell.
+BASH_ENV=/dev/null
+ENV=/dev/null
+(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
+case $- in # ((((
+ *v*x* | *x*v* ) as_opts=-vx ;;
+ *v* ) as_opts=-v ;;
+ *x* ) as_opts=-x ;;
+ * ) as_opts= ;;
+esac
+exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
+# Admittedly, this is quite paranoid, since all the known shells bail
+# out after a failed `exec'.
+$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
+exit 255
fi
if test x$as_have_required = xno; then :
@@ -328,6 +356,14 @@ $as_echo X"$as_dir" |
} # as_fn_mkdir_p
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
@@ -449,6 +485,10 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits
chmod +x "$as_me.lineno" ||
{ $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
+ # If we had to re-execute with $CONFIG_SHELL, we're ensured to have
+ # already done that, so ensure we don't try to do so again and fall
+ # in an infinite loop. This has already happened in practice.
+ _as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
# original and so on. Autoconf is especially sensitive to this).
@@ -483,16 +523,16 @@ if (echo >conf$$.file) 2>/dev/null; then
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
+ # In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@@ -504,28 +544,8 @@ else
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -557,8 +577,8 @@ MAKEFLAGS=
# Identity of this package.
PACKAGE_NAME='ocaml-libvirt'
PACKAGE_TARNAME='ocaml-libvirt'
-PACKAGE_VERSION='0.6.1.2'
-PACKAGE_STRING='ocaml-libvirt 0.6.1.2'
+PACKAGE_VERSION='0.6.1.4'
+PACKAGE_STRING='ocaml-libvirt 0.6.1.4'
PACKAGE_BUGREPORT=''
PACKAGE_URL=''
@@ -1152,8 +1172,6 @@ target=$target_alias
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
- $as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.
- If a cross compiler is detected then cross compile mode will be used" >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
@@ -1239,7 +1257,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures ocaml-libvirt 0.6.1.2 to adapt to many kinds of systems.
+\`configure' configures ocaml-libvirt 0.6.1.4 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1304,7 +1322,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of ocaml-libvirt 0.6.1.2:";;
+ short | recursive ) echo "Configuration of ocaml-libvirt 0.6.1.4:";;
esac
cat <<\_ACEOF
@@ -1390,10 +1408,10 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-ocaml-libvirt configure 0.6.1.2
-generated by GNU Autoconf 2.68
+ocaml-libvirt configure 0.6.1.4
+generated by GNU Autoconf 2.69
-Copyright (C) 2010 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
@@ -1506,7 +1524,7 @@ $as_echo "$ac_try_echo"; } >&5
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
- $as_test_x conftest$ac_exeext
+ test -x conftest$ac_exeext
}; then :
ac_retval=0
else
@@ -1684,133 +1702,12 @@ $as_echo "$ac_res" >&6; }
eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
} # ac_fn_c_check_header_compile
-
-# ac_fn_c_check_func LINENO FUNC VAR
-# ----------------------------------
-# Tests whether FUNC exists, setting the cache variable VAR accordingly
-ac_fn_c_check_func ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
-$as_echo_n "checking for $2... " >&6; }
-if eval \${$3+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-/* Define $2 to an innocuous variant, in case <limits.h> declares $2.
- For example, HP-UX 11i <limits.h> declares gettimeofday. */
-#define $2 innocuous_$2
-
-/* System header to define __stub macros and hopefully few prototypes,
- which can conflict with char $2 (); below.
- Prefer <limits.h> to <assert.h> if __STDC__ is defined, since
- <limits.h> exists even on freestanding compilers. */
-
-#ifdef __STDC__
-# include <limits.h>
-#else
-# include <assert.h>
-#endif
-
-#undef $2
-
-/* Override any GCC internal prototype to avoid an error.
- Use char because int might match the return type of a GCC
- builtin and then its argument prototype would still apply. */
-#ifdef __cplusplus
-extern "C"
-#endif
-char $2 ();
-/* The GNU C library defines this for functions which it implements
- to always fail with ENOSYS. Some functions are actually named
- something starting with __ and the normal name is an alias. */
-#if defined __stub_$2 || defined __stub___$2
-choke me
-#endif
-
-int
-main ()
-{
-return $2 ();
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_link "$LINENO"; then :
- eval "$3=yes"
-else
- eval "$3=no"
-fi
-rm -f core conftest.err conftest.$ac_objext \
- conftest$ac_exeext conftest.$ac_ext
-fi
-eval ac_res=\$$3
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_c_check_func
-
-# ac_fn_c_check_type LINENO TYPE VAR INCLUDES
-# -------------------------------------------
-# Tests whether TYPE exists after having included INCLUDES, setting cache
-# variable VAR accordingly.
-ac_fn_c_check_type ()
-{
- as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack
- { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5
-$as_echo_n "checking for $2... " >&6; }
-if eval \${$3+:} false; then :
- $as_echo_n "(cached) " >&6
-else
- eval "$3=no"
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-if (sizeof ($2))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
- cat confdefs.h - <<_ACEOF >conftest.$ac_ext
-/* end confdefs.h. */
-$4
-int
-main ()
-{
-if (sizeof (($2)))
- return 0;
- ;
- return 0;
-}
-_ACEOF
-if ac_fn_c_try_compile "$LINENO"; then :
-
-else
- eval "$3=yes"
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext
-fi
-eval ac_res=\$$3
- { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5
-$as_echo "$ac_res" >&6; }
- eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno
-
-} # ac_fn_c_check_type
cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by ocaml-libvirt $as_me 0.6.1.2, which was
-generated by GNU Autoconf 2.68. Invocation command line was
+It was created by ocaml-libvirt $as_me 0.6.1.4, which was
+generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@@ -2180,7 +2077,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2220,7 +2117,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2273,7 +2170,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2314,7 +2211,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
@@ -2372,7 +2269,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2416,7 +2313,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -2862,8 +2759,7 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
-#include <sys/types.h>
-#include <sys/stat.h>
+struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
@@ -3014,7 +2910,7 @@ case $as_dir/ in #((
# by default.
for ac_prog in ginstall scoinst install; do
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
if test $ac_prog = install &&
grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
# AIX install. It has an incompatible calling convention.
@@ -3500,7 +3396,7 @@ do
for ac_prog in grep ggrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
- { test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
+ as_fn_executable_p "$ac_path_GREP" || continue
# Check for GNU ac_path_GREP and select it if it is found.
# Check for GNU $ac_path_GREP
case `"$ac_path_GREP" --version 2>&1` in
@@ -3566,7 +3462,7 @@ do
for ac_prog in egrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
- { test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
+ as_fn_executable_p "$ac_path_EGREP" || continue
# Check for GNU ac_path_EGREP and select it if it is found.
# Check for GNU $ac_path_EGREP
case `"$ac_path_EGREP" --version 2>&1` in
@@ -3761,100 +3657,6 @@ fi
-ac_fn_c_check_func "$LINENO" "virConnectGetCapabilities" "ac_cv_func_virConnectGetCapabilities"
-if test "x$ac_cv_func_virConnectGetCapabilities" = xyes; then :
-
-else
- as_fn_error $? "You must have libvirt >= 0.2.1" "$LINENO" 5
-fi
-
-
-for ac_func in virConnectGetHostname \
- virConnectGetURI \
- virDomainBlockStats \
- virDomainGetSchedulerParameters \
- virDomainGetSchedulerType \
- virDomainInterfaceStats \
- virDomainMigrate \
- virDomainSetSchedulerParameters \
- virNodeGetFreeMemory \
- virNodeGetCellsFreeMemory \
- virStoragePoolGetConnect \
- virConnectNumOfStoragePools \
- virConnectListStoragePools \
- virConnectNumOfDefinedStoragePools \
- virConnectListDefinedStoragePools \
- virStoragePoolLookupByName \
- virStoragePoolLookupByUUID \
- virStoragePoolLookupByUUIDString \
- virStoragePoolLookupByVolume \
- virStoragePoolCreateXML \
- virStoragePoolDefineXML \
- virStoragePoolBuild \
- virStoragePoolUndefine \
- virStoragePoolCreate \
- virStoragePoolDestroy \
- virStoragePoolDelete \
- virStoragePoolFree \
- virStoragePoolRefresh \
- virStoragePoolGetName \
- virStoragePoolGetUUID \
- virStoragePoolGetUUIDString \
- virStoragePoolGetInfo \
- virStoragePoolGetXMLDesc \
- virStoragePoolGetAutostart \
- virStoragePoolSetAutostart \
- virStoragePoolNumOfVolumes \
- virStoragePoolListVolumes \
- virStorageVolLookupByName \
- virStorageVolLookupByKey \
- virStorageVolLookupByPath \
- virStorageVolGetName \
- virStorageVolGetKey \
- virStorageVolCreateXML \
- virStorageVolDelete \
- virStorageVolFree \
- virStorageVolGetInfo \
- virStorageVolGetXMLDesc \
- virStorageVolGetPath \
- virDomainBlockPeek \
- virDomainMemoryPeek \
- virDomainGetCPUStats \
-
-do :
- as_ac_var=`$as_echo "ac_cv_func_$ac_func" | $as_tr_sh`
-ac_fn_c_check_func "$LINENO" "$ac_func" "$as_ac_var"
-if eval test \"x\$"$as_ac_var"\" = x"yes"; then :
- cat >>confdefs.h <<_ACEOF
-#define `$as_echo "HAVE_$ac_func" | $as_tr_cpp` 1
-_ACEOF
-
-fi
-done
-
-
-ac_fn_c_check_type "$LINENO" "virStoragePoolPtr" "ac_cv_type_virStoragePoolPtr" "#include <libvirt/libvirt.h>
-"
-if test "x$ac_cv_type_virStoragePoolPtr" = xyes; then :
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_VIRSTORAGEPOOLPTR 1
-_ACEOF
-
-
-fi
-ac_fn_c_check_type "$LINENO" "virStorageVolPtr" "ac_cv_type_virStorageVolPtr" "#include <libvirt/libvirt.h>
-"
-if test "x$ac_cv_type_virStorageVolPtr" = xyes; then :
-
-cat >>confdefs.h <<_ACEOF
-#define HAVE_VIRSTORAGEVOLPTR 1
-_ACEOF
-
-
-fi
-
-
# checking for ocamlc
# Extract the first word of "ocamlc", so it can be a program name with args.
set dummy ocamlc; ac_word=$2
@@ -3872,7 +3674,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLC="ocamlc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3917,7 +3719,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLOPT="ocamlopt"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -3969,7 +3771,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLCDOTOPT="ocamlc.opt"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4017,7 +3819,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLOPTDOTOPT="ocamlopt.opt"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4065,7 +3867,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLDEP="ocamldep"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4105,7 +3907,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLMKTOP="ocamlmktop"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4145,7 +3947,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLMKLIB="ocamlmklib"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4185,7 +3987,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLDOC="ocamldoc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4236,7 +4038,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_OCAMLFIND="ocamlfind"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4329,7 +4131,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
- if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
+ if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_MAKENSIS="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@@ -4850,16 +4652,16 @@ if (echo >conf$$.file) 2>/dev/null; then
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
- # In both cases, we have to default to `cp -p'.
+ # In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
else
- as_ln_s='cp -p'
+ as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@@ -4919,28 +4721,16 @@ else
as_mkdir_p=false
fi
-if test -x / >/dev/null 2>&1; then
- as_test_x='test -x'
-else
- if ls -dL / >/dev/null 2>&1; then
- as_ls_L_option=L
- else
- as_ls_L_option=
- fi
- as_test_x='
- eval sh -c '\''
- if test -d "$1"; then
- test -d "$1/.";
- else
- case $1 in #(
- -*)set "./$1";;
- esac;
- case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
- ???[sx]*):;;*)false;;esac;fi
- '\'' sh
- '
-fi
-as_executable_p=$as_test_x
+
+# as_fn_executable_p FILE
+# -----------------------
+# Test if FILE is an executable regular file.
+as_fn_executable_p ()
+{
+ test -f "$1" && test -x "$1"
+} # as_fn_executable_p
+as_test_x='test -x'
+as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@@ -4961,8 +4751,8 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by ocaml-libvirt $as_me 0.6.1.2, which was
-generated by GNU Autoconf 2.68. Invocation command line was
+This file was extended by ocaml-libvirt $as_me 0.6.1.4, which was
+generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@@ -5023,11 +4813,11 @@ _ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
-ocaml-libvirt config.status 0.6.1.2
-configured by $0, generated by GNU Autoconf 2.68,
+ocaml-libvirt config.status 0.6.1.4
+configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
-Copyright (C) 2010 Free Software Foundation, Inc.
+Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
@@ -5116,7 +4906,7 @@ fi
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
- set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
+ set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
shift
\$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
CONFIG_SHELL='$SHELL'
diff --git a/configure.ac b/configure.ac
index 63635b6..758fcc5 100644
--- a/configure.ac
+++ b/configure.ac
@@ -17,7 +17,7 @@
dnl Process this file with autoconf to produce a configure script.
-AC_INIT(ocaml-libvirt,0.6.1.2)
+AC_INIT(ocaml-libvirt,0.6.1.4)
dnl Check for basic C environment.
AC_PROG_CC
@@ -67,71 +67,6 @@ AC_CHECK_HEADER([libvirt/virterror.h],
[],
AC_MSG_ERROR([You must install libvirt development package]))
-dnl Check for libvirt >= 0.2.1 (our minimum supported version).
-dnl See: http://libvirt.org/hvsupport.html
-AC_CHECK_FUNC(virConnectGetCapabilities,
- [],
- AC_MSG_ERROR([You must have libvirt >= 0.2.1]))
-
-dnl Check for optional libvirt functions added since 0.2.1.
-dnl See: http://libvirt.org/hvsupport.html
-AC_CHECK_FUNCS([virConnectGetHostname \
- virConnectGetURI \
- virDomainBlockStats \
- virDomainGetSchedulerParameters \
- virDomainGetSchedulerType \
- virDomainInterfaceStats \
- virDomainMigrate \
- virDomainSetSchedulerParameters \
- virNodeGetFreeMemory \
- virNodeGetCellsFreeMemory \
- virStoragePoolGetConnect \
- virConnectNumOfStoragePools \
- virConnectListStoragePools \
- virConnectNumOfDefinedStoragePools \
- virConnectListDefinedStoragePools \
- virStoragePoolLookupByName \
- virStoragePoolLookupByUUID \
- virStoragePoolLookupByUUIDString \
- virStoragePoolLookupByVolume \
- virStoragePoolCreateXML \
- virStoragePoolDefineXML \
- virStoragePoolBuild \
- virStoragePoolUndefine \
- virStoragePoolCreate \
- virStoragePoolDestroy \
- virStoragePoolDelete \
- virStoragePoolFree \
- virStoragePoolRefresh \
- virStoragePoolGetName \
- virStoragePoolGetUUID \
- virStoragePoolGetUUIDString \
- virStoragePoolGetInfo \
- virStoragePoolGetXMLDesc \
- virStoragePoolGetAutostart \
- virStoragePoolSetAutostart \
- virStoragePoolNumOfVolumes \
- virStoragePoolListVolumes \
- virStorageVolLookupByName \
- virStorageVolLookupByKey \
- virStorageVolLookupByPath \
- virStorageVolGetName \
- virStorageVolGetKey \
- virStorageVolCreateXML \
- virStorageVolDelete \
- virStorageVolFree \
- virStorageVolGetInfo \
- virStorageVolGetXMLDesc \
- virStorageVolGetPath \
- virDomainBlockPeek \
- virDomainMemoryPeek \
- virDomainGetCPUStats \
-])
-
-dnl Check for optional types added since 0.2.1.
-AC_CHECK_TYPES([virStoragePoolPtr, virStorageVolPtr],,,
- [#include <libvirt/libvirt.h>])
-
dnl Check for basic OCaml environment & findlib.
AC_PROG_OCAML
AC_PROG_FINDLIB
diff --git a/contrib/0001-Add-Libvirt.Domain.get_cpu_stats_total.patch b/contrib/0001-Add-Libvirt.Domain.get_cpu_stats_total.patch
new file mode 100644
index 0000000..d4a496d
--- /dev/null
+++ b/contrib/0001-Add-Libvirt.Domain.get_cpu_stats_total.patch
@@ -0,0 +1,249 @@
+From 99ba7e0eae5ea7567aded458ab63c5984ed43191 Mon Sep 17 00:00:00 2001
+From: Hu Tao <hutao@cn.fujitsu.com>
+Date: Wed, 9 May 2012 16:48:31 +0800
+Subject: [PATCH] Add Libvirt.Domain.get_cpu_stats_total.
+
+Original patch by Hu Tao.
+
+RWMJ modified the patch to split this into two functions
+(old get_cpu_stats and new get_cpu_stats_total). Apart
+from that split, the code is identical.
+---
+ examples/.depend | 12 +++---
+ examples/get_cpu_stats.ml | 48 +++++++++++++-----------
+ libvirt/.depend | 12 +++---
+ libvirt/libvirt.ml | 1 +
+ libvirt/libvirt.mli | 6 ++-
+ libvirt/libvirt_c_oneoffs.c | 89 +++++++++++++++++++++++++++++++++++++++++++++
+ 6 files changed, 134 insertions(+), 34 deletions(-)
+
+diff --git a/examples/.depend b/examples/.depend
+index f58db3d..3d955f9 100644
+--- a/examples/.depend
++++ b/examples/.depend
+@@ -1,6 +1,6 @@
+-get_cpu_stats.cmo: ../libvirt/libvirt.cmi
+-get_cpu_stats.cmx: ../libvirt/libvirt.cmx
+-list_domains.cmo: ../libvirt/libvirt.cmi
+-list_domains.cmx: ../libvirt/libvirt.cmx
+-node_info.cmo: ../libvirt/libvirt.cmi
+-node_info.cmx: ../libvirt/libvirt.cmx
++node_info.cmo : ../libvirt/libvirt.cmi
++node_info.cmx : ../libvirt/libvirt.cmx
++get_cpu_stats.cmo : ../libvirt/libvirt.cmi
++get_cpu_stats.cmx : ../libvirt/libvirt.cmx
++list_domains.cmo : ../libvirt/libvirt.cmi
++list_domains.cmx : ../libvirt/libvirt.cmx
+diff --git a/examples/get_cpu_stats.ml b/examples/get_cpu_stats.ml
+index d7a8d0c..10b3840 100644
+--- a/examples/get_cpu_stats.ml
++++ b/examples/get_cpu_stats.ml
+@@ -18,32 +18,38 @@ let () =
+ let domname = Sys.argv.(1) in
+
+ let conn = C.connect_readonly () in
+-
+- let nr_pcpus =
+- let info = C.get_node_info conn in
+- C.maxcpus_of_node_info info in
+-
+- let stats =
+- let dom = D.lookup_by_name conn domname in
+- D.get_cpu_stats dom in
++ let dom = D.lookup_by_name conn domname in
++ let stats = D.get_cpu_stats dom in
++ let total_stats = D.get_cpu_stats_total dom in
++
++ let print_params n params =
++ List.iter (
++ fun (name, value) ->
++ printf " %s=" name;
++ match value with
++ | D.TypedFieldInt32 i -> printf "%ld" i
++ | D.TypedFieldUInt32 i -> printf "%ld" i
++ | D.TypedFieldInt64 i -> printf "%Ld" i
++ | D.TypedFieldUInt64 i -> printf "%Ld" i
++ | D.TypedFieldFloat f -> printf "%g" f
++ | D.TypedFieldBool b -> printf "%b" b
++ | D.TypedFieldString s -> printf "%S" s
++ ) params in
+
+ Array.iteri (
+ fun n params ->
+ printf "pCPU %d:" n;
+- List.iter (
+- fun (name, value) ->
+- printf " %s=" name;
+- match value with
+- | D.TypedFieldInt32 i -> printf "%ld" i
+- | D.TypedFieldUInt32 i -> printf "%ld" i
+- | D.TypedFieldInt64 i -> printf "%Ld" i
+- | D.TypedFieldUInt64 i -> printf "%Ld" i
+- | D.TypedFieldFloat f -> printf "%g" f
+- | D.TypedFieldBool b -> printf "%b" b
+- | D.TypedFieldString s -> printf "%S" s
+- ) params;
++ print_params n params;
+ printf "\n"
+- ) stats
++ ) stats;
++
++ Array.iteri (
++ fun n params ->
++ printf "total:";
++ print_params n params;
++ printf "\n"
++ ) total_stats
++
+ with
+ Libvirt.Virterror err ->
+ eprintf "error: %s\n" (Libvirt.Virterror.to_string err)
+diff --git a/libvirt/.depend b/libvirt/.depend
+index 3f2297e..7d32e13 100644
+--- a/libvirt/.depend
++++ b/libvirt/.depend
+@@ -1,6 +1,6 @@
+-libvirt.cmi:
+-libvirt_version.cmi:
+-libvirt.cmo: libvirt.cmi
+-libvirt.cmx: libvirt.cmi
+-libvirt_version.cmo: libvirt_version.cmi
+-libvirt_version.cmx: libvirt_version.cmi
++libvirt_version.cmi :
++libvirt.cmi :
++libvirt_version.cmo : libvirt_version.cmi
++libvirt_version.cmx : libvirt_version.cmi
++libvirt.cmo : libvirt.cmi
++libvirt.cmx : libvirt.cmi
+diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
+index 07542a9..2997b0b 100644
+--- a/libvirt/libvirt.ml
++++ b/libvirt/libvirt.ml
+@@ -418,6 +418,7 @@ struct
+ 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_cpu_stats : [>`R] t -> typed_param list array = "ocaml_libvirt_domain_get_cpu_stats"
++ external get_cpu_stats_total : [>`R] t -> typed_param list array = "ocaml_libvirt_domain_get_cpu_stats_total"
+ 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"
+diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
+index 5a288c0..020be59 100644
+--- a/libvirt/libvirt.mli
++++ b/libvirt/libvirt.mli
+@@ -560,7 +560,11 @@ sig
+ of the array and bitmap returned from this function.
+ *)
+ val get_cpu_stats : [>`R] t -> typed_param list array
+- (** [get_pcpu_stats dom] returns the physical CPU stats
++ (** [get_cpu_stats dom] returns the per-CPU physical CPU stats
++ for a domain. See the libvirt documentation for details.
++ *)
++ val get_cpu_stats_total : [>`R] t -> typed_param list array
++ (** [get_cpu_stats dom] returns the total physical CPU stats
+ for a domain. See the libvirt documentation for details.
+ *)
+ val get_max_vcpus : [>`R] t -> int
+diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
+index 70cf96f..2a1850f 100644
+--- a/libvirt/libvirt_c_oneoffs.c
++++ b/libvirt/libvirt_c_oneoffs.c
+@@ -638,6 +638,95 @@ ocaml_libvirt_domain_get_cpu_stats (value domv)
+ #endif
+ }
+
++CAMLprim value
++ocaml_libvirt_domain_get_cpu_stats_total (value domv)
++{
++#ifdef HAVE_VIRDOMAINGETCPUSTATS
++ CAMLparam1 (domv);
++ CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
++ CAMLlocal1 (v);
++ virDomainPtr dom = Domain_val (domv);
++ virConnectPtr conn = Connect_domv (domv);
++ virTypedParameterPtr params;
++ int r, nparams, j, pos;
++
++ /* get total information */
++ NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, -1, 1, 0));
++ CHECK_ERROR (nparams < 0, conn, "virDomainGetCPUStats");
++
++ if ((params = malloc(sizeof(*params) * nparams)) == NULL)
++ caml_failwith ("virDomainGetCPUStats: malloc");
++
++ cpustats = caml_alloc (1, 0); /* cpustats: array of params(list of typed_param) */
++
++ NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, -1, 1, 0));
++ CHECK_ERROR (r < 0, conn, "virDomainGetCPUStats");
++
++ param_head = Val_emptylist;
++ if (params[nparams].type != 0) {
++ for (j = r - 1; j >= 0; j--) {
++ pos = j;
++
++ param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
++ Store_field(param_node, 1, param_head);
++ param_head = param_node;
++
++ typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
++ Store_field(param_node, 0, typed_param);
++ Store_field(typed_param, 0, caml_copy_string(params[pos].field));
++
++ /* typed_param_value: value with the corresponding type tag */
++ switch(params[pos].type) {
++ case VIR_TYPED_PARAM_INT:
++ typed_param_value = caml_alloc (1, 0);
++ v = caml_copy_int32 (params[pos].value.i);
++ break;
++ case VIR_TYPED_PARAM_UINT:
++ typed_param_value = caml_alloc (1, 1);
++ v = caml_copy_int32 (params[pos].value.ui);
++ break;
++ case VIR_TYPED_PARAM_LLONG:
++ typed_param_value = caml_alloc (1, 2);
++ v = caml_copy_int64 (params[pos].value.l);
++ break;
++ case VIR_TYPED_PARAM_ULLONG:
++ typed_param_value = caml_alloc (1, 3);
++ v = caml_copy_int64 (params[pos].value.ul);
++ break;
++ case VIR_TYPED_PARAM_DOUBLE:
++ typed_param_value = caml_alloc (1, 4);
++ v = caml_copy_double (params[pos].value.d);
++ break;
++ case VIR_TYPED_PARAM_BOOLEAN:
++ typed_param_value = caml_alloc (1, 5);
++ v = Val_bool (params[pos].value.b);
++ break;
++ case VIR_TYPED_PARAM_STRING:
++ typed_param_value = caml_alloc (1, 6);
++ v = caml_copy_string (params[pos].value.s);
++ free (params[pos].value.s);
++ break;
++ default:
++ /* XXX Memory leak on this path, if there are more
++ * VIR_TYPED_PARAM_STRING past this point in the array.
++ */
++ free (params);
++ caml_failwith ("virDomainGetCPUStats: "
++ "unknown parameter type returned");
++ }
++ Store_field (typed_param_value, 0, v);
++ Store_field (typed_param, 1, typed_param_value);
++ }
++ }
++ Store_field (cpustats, 0, param_head);
++
++ free(params);
++ CAMLreturn (cpustats);
++#else
++ not_supported ("virDomainGetCPUStats");
++#endif
++}
++
+ #ifdef HAVE_WEAK_SYMBOLS
+ #ifdef HAVE_VIRDOMAINMIGRATE
+ extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
+--
+1.7.11.4
+
diff --git a/examples/.depend b/examples/.depend
index 831adf6..b305b76 100644
--- a/examples/.depend
+++ b/examples/.depend
@@ -1,6 +1,8 @@
-node_info.cmo: ../libvirt/libvirt.cmi
-node_info.cmx: ../libvirt/libvirt.cmx
-get_cpu_stats.cmo: ../libvirt/libvirt.cmi
-get_cpu_stats.cmx: ../libvirt/libvirt.cmx
-list_domains.cmo: ../libvirt/libvirt.cmi
-list_domains.cmx: ../libvirt/libvirt.cmx
+node_info.cmo : ../libvirt/libvirt.cmi
+node_info.cmx : ../libvirt/libvirt.cmx
+get_cpu_stats.cmo : ../libvirt/libvirt.cmi
+get_cpu_stats.cmx : ../libvirt/libvirt.cmx
+domain_events.cmo : ../libvirt/libvirt.cmi
+domain_events.cmx : ../libvirt/libvirt.cmx
+list_domains.cmo : ../libvirt/libvirt.cmi
+list_domains.cmx : ../libvirt/libvirt.cmx
diff --git a/examples/Makefile.in b/examples/Makefile.in
index 2eb220a..041e382 100644
--- a/examples/Makefile.in
+++ b/examples/Makefile.in
@@ -27,7 +27,7 @@ OCAMLOPTLIBS := $(OCAMLCLIBS)
export LIBRARY_PATH=../libvirt
export LD_LIBRARY_PATH=../libvirt
-BYTE_TARGETS := list_domains node_info get_cpu_stats
+BYTE_TARGETS := list_domains node_info get_cpu_stats domain_events
OPT_TARGETS := $(BYTE_TARGETS:%=%.opt)
all: $(BYTE_TARGETS)
@@ -64,6 +64,17 @@ get_cpu_stats.opt: get_cpu_stats.cmx
$(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \
../libvirt/mllibvirt.cmxa -o $@ $<
+domain_events: domain_events.cmo
+ $(OCAMLFIND) ocamlc \
+ $(OCAMLCPACKAGES) $(OCAMLCFLAGS) $(OCAMLCLIBS) \
+ ../libvirt/mllibvirt.cma -o $@ $<
+
+domain_events.opt: domain_events.cmx
+ $(OCAMLFIND) ocamlopt \
+ $(OCAMLOPTPACKAGES) $(OCAMLOPTFLAGS) $(OCAMLOPTLIBS) \
+ ../libvirt/mllibvirt.cmxa -o $@ $<
+
+
install-opt install-byte:
include ../Make.rules
diff --git a/examples/domain_events.ml b/examples/domain_events.ml
new file mode 100644
index 0000000..03cecd9
--- /dev/null
+++ b/examples/domain_events.ml
@@ -0,0 +1,145 @@
+(* Simple demo program showing how to receive domain events.
+ Usage: domain_events [URI]
+ (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
+ (C) Copyright 2013 Citrix Inc
+ http://libvirt.org/
+ *)
+
+open Printf
+
+module C = Libvirt.Connect
+module D = Libvirt.Domain
+module E = Libvirt.Event
+module N = Libvirt.Network
+
+let string_of_state = function
+ | D.InfoNoState -> "no state"
+ | D.InfoRunning -> "running"
+ | D.InfoBlocked -> "blocked"
+ | D.InfoPaused -> "paused"
+ | D.InfoShutdown -> "shutdown"
+ | D.InfoShutoff -> "shutoff"
+ | D.InfoCrashed -> "crashed"
+
+let printd dom fmt =
+ let prefix dom =
+ let id = D.get_id dom in
+ try
+ let name = D.get_name dom in
+ let info = D.get_info dom in
+ let state = string_of_state info.D.state in
+ sprintf "%8d %-20s %s " id name state
+ with _ ->
+ sprintf "%8d " id in
+ let write x =
+ output_string stdout (prefix dom);
+ output_string stdout x;
+ output_string stdout "\n";
+ flush stdout in
+ Printf.ksprintf write fmt
+
+let string_option = function
+ | None -> "None"
+ | Some x -> "Some " ^ x
+
+let string_of_graphics_address (family, node, service) =
+ Printf.sprintf "{ family=%d; node=%s; service=%s }" family (string_option node) (string_option service)
+
+let string_of_graphics_subject_identity (ty, name) =
+ Printf.sprintf "{ type=%s; name=%s }" (string_option ty) (string_option name)
+
+let string_of_graphics_subject xs = String.concat "; " (List.map string_of_graphics_subject_identity (Array.to_list xs))
+
+let map_option f = function
+ | None -> None
+ | Some x -> Some (f x)
+
+let () =
+ try
+ E.register_default_impl ();
+ let name =
+ if Array.length Sys.argv >= 2 then
+ Some (Sys.argv.(1))
+ else
+ None in
+ let conn = C.connect_readonly ?name () in
+
+ let spinner = [| '|'; '/'; '-'; '\\' |] in
+
+ let timeouts = ref 0 in
+ (* Check add/remove works *)
+ let id = E.add_timeout conn 250 (fun () -> Printf.printf "This callback is immediately deregistered\n%!") in
+ E.remove_timeout conn id;
+
+ let (_: E.timer_id) = E.add_timeout conn 250 (* ms *)
+ (fun () ->
+ incr timeouts;
+ Printf.printf "\r%c %d timeout callbacks%!" (spinner.(!timeouts mod (Array.length spinner))) !timeouts;
+ (* Check for GC errors: *)
+ Gc.compact ()
+ ) in
+
+ (* Check add/remove works *)
+ let id = E.register_any conn (E.Lifecycle (fun dom e ->
+ printd dom "Removed Lifecycle callback %s" (E.Lifecycle.to_string e)
+ )) in
+ E.deregister_any conn id;
+
+ let (_: E.callback_id) = E.register_any conn (E.Lifecycle (fun dom e ->
+ printd dom "Lifecycle %s" (E.Lifecycle.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.Reboot (fun dom e ->
+ printd dom "Reboot %s" (E.Reboot.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.RtcChange (fun dom e ->
+ printd dom "RtcChange %s" (E.Rtc_change.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.Watchdog (fun dom e ->
+ printd dom "Watchdog %s" (E.Watchdog.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.IOError (fun dom e ->
+ printd dom "IOError %s" (E.Io_error.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.IOErrorReason (fun dom e ->
+ printd dom "IOErrorReason %s" (E.Io_error.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.Graphics (fun dom e ->
+ printd dom "Graphics %s" (E.Graphics.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.ControlError (fun dom e ->
+ printd dom "ControlError %s" (E.Control_error.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.BlockJob (fun dom e ->
+ printd dom "BlockJob %s" (E.Block_job.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.DiskChange (fun dom e ->
+ printd dom "DiskChange %s" (E.Disk_change.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.TrayChange (fun dom e ->
+ printd dom "TrayChange %s" (E.Tray_change.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.PMWakeUp (fun dom e ->
+ printd dom "PMWakeup %s" (E.PM_wakeup.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.PMSuspend (fun dom e ->
+ printd dom "PMSuspend %s" (E.PM_suspend.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.BalloonChange (fun dom e ->
+ printd dom "BalloonChange %s" (E.Balloon_change.to_string e)
+ )) in
+ let (_: E.callback_id) = E.register_any conn (E.PMSuspendDisk (fun dom x ->
+ printd dom "PMSuspendDisk %s" (E.PM_suspend_disk.to_string x)
+ )) in
+ C.set_keep_alive conn 5 3;
+ while true do
+ E.run_default_impl ()
+ done
+ with
+ Libvirt.Virterror err ->
+ eprintf "error: %s\n" (Libvirt.Virterror.to_string err)
+
+let () =
+ (* Run the garbage collector which is a good way to check for
+ * memory corruption errors and reference counting issues in libvirt.
+ *)
+ Gc.compact ()
diff --git a/examples/get_cpu_stats.ml b/examples/get_cpu_stats.ml
index 79d5c3c..d7a8d0c 100644
--- a/examples/get_cpu_stats.ml
+++ b/examples/get_cpu_stats.ml
@@ -25,7 +25,7 @@ let () =
let stats =
let dom = D.lookup_by_name conn domname in
- D.get_cpu_stats dom nr_pcpus in
+ D.get_cpu_stats dom in
Array.iteri (
fun n params ->
diff --git a/libvirt/.depend b/libvirt/.depend
index 43a2367..7d32e13 100644
--- a/libvirt/.depend
+++ b/libvirt/.depend
@@ -1,6 +1,6 @@
-libvirt_version.cmi:
-libvirt.cmi:
-libvirt_version.cmo: libvirt_version.cmi
-libvirt_version.cmx: libvirt_version.cmi
-libvirt.cmo: libvirt.cmi
-libvirt.cmx: libvirt.cmi
+libvirt_version.cmi :
+libvirt.cmi :
+libvirt_version.cmo : libvirt_version.cmi
+libvirt_version.cmx : libvirt_version.cmi
+libvirt.cmo : libvirt.cmi
+libvirt.cmx : libvirt.cmi
diff --git a/libvirt/generator.pl b/libvirt/generator.pl
index 8590ea7..8229ad1 100755
--- a/libvirt/generator.pl
+++ b/libvirt/generator.pl
@@ -35,13 +35,11 @@ use strict;
# It is interpreted by the generation functions below to indicate what
# "class" the function falls into, and to generate the right class of
# binding.
-#
-# Any function added since libvirt 0.2.1 must be marked weak.
my @functions = (
{ name => "virConnectClose", sig => "conn : free" },
- { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
- { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
+ { name => "virConnectGetHostname", sig => "conn : string" },
+ { name => "virConnectGetURI", sig => "conn : string" },
{ name => "virConnectGetType", sig => "conn : static string" },
{ name => "virConnectNumOfDomains", sig => "conn : int" },
{ name => "virConnectListDomains", sig => "conn, int : int array" },
@@ -53,14 +51,16 @@ my @functions = (
{ name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
{ name => "virConnectListDefinedNetworks",
sig => "conn, int : string array" },
- { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
+ { name => "virConnectNumOfStoragePools", sig => "conn : int" },
{ name => "virConnectListStoragePools",
- sig => "conn, int : string array", weak => 1 },
+ sig => "conn, int : string array" },
{ name => "virConnectNumOfDefinedStoragePools",
- sig => "conn : int", weak => 1 },
+ sig => "conn : int" },
{ name => "virConnectListDefinedStoragePools",
- sig => "conn, int : string array", weak => 1 },
+ sig => "conn, int : string array" },
{ name => "virConnectGetCapabilities", sig => "conn : string" },
+ { name => "virConnectDomainEventDeregisterAny",
+ sig => "conn, int : unit" },
{ name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
{ name => "virDomainFree", sig => "dom : free" },
@@ -107,66 +107,66 @@ my @functions = (
{ name => "virNetworkGetAutostart", sig => "net : bool" },
{ name => "virNetworkSetAutostart", sig => "net, bool : unit" },
- { name => "virStoragePoolFree", sig => "pool : free", weak => 1 },
- { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 },
+ { name => "virStoragePoolFree", sig => "pool : free" },
+ { name => "virStoragePoolDestroy", sig => "pool : free" },
{ name => "virStoragePoolLookupByName",
- sig => "conn, string : pool", weak => 1 },
+ sig => "conn, string : pool" },
{ name => "virStoragePoolLookupByUUID",
- sig => "conn, uuid : pool", weak => 1 },
+ sig => "conn, uuid : pool" },
{ name => "virStoragePoolLookupByUUIDString",
- sig => "conn, string : pool", weak => 1 },
+ sig => "conn, string : pool" },
{ name => "virStoragePoolGetName",
- sig => "pool : static string", weak => 1 },
+ sig => "pool : static string" },
{ name => "virStoragePoolGetXMLDesc",
- sig => "pool, 0U : string", weak => 1 },
+ sig => "pool, 0U : string" },
{ name => "virStoragePoolGetUUID",
- sig => "pool : uuid", weak => 1 },
+ sig => "pool : uuid" },
{ name => "virStoragePoolGetUUIDString",
- sig => "pool : uuid string", weak => 1 },
+ sig => "pool : uuid string" },
{ name => "virStoragePoolCreateXML",
- sig => "conn, string, 0U : pool", weak => 1 },
+ sig => "conn, string, 0U : pool" },
{ name => "virStoragePoolDefineXML",
- sig => "conn, string, 0U : pool", weak => 1 },
+ sig => "conn, string, 0U : pool" },
{ name => "virStoragePoolBuild",
- sig => "pool, uint : unit", weak => 1 },
+ sig => "pool, uint : unit" },
{ name => "virStoragePoolUndefine",
- sig => "pool : unit", weak => 1 },
+ sig => "pool : unit" },
{ name => "virStoragePoolCreate",
- sig => "pool, 0U : unit", weak => 1 },
+ sig => "pool, 0U : unit" },
{ name => "virStoragePoolDelete",
- sig => "pool, uint : unit", weak => 1 },
+ sig => "pool, uint : unit" },
{ name => "virStoragePoolRefresh",
- sig => "pool, 0U : unit", weak => 1 },
+ sig => "pool, 0U : unit" },
{ name => "virStoragePoolGetAutostart",
- sig => "pool : bool", weak => 1 },
+ sig => "pool : bool" },
{ name => "virStoragePoolSetAutostart",
- sig => "pool, bool : unit", weak => 1 },
+ sig => "pool, bool : unit" },
{ name => "virStoragePoolNumOfVolumes",
- sig => "pool : int", weak => 1 },
+ sig => "pool : int" },
{ name => "virStoragePoolListVolumes",
- sig => "pool, int : string array", weak => 1 },
+ sig => "pool, int : string array" },
- { name => "virStorageVolFree", sig => "vol : free", weak => 1 },
+ { name => "virStorageVolFree", sig => "vol : free" },
{ name => "virStorageVolDelete",
- sig => "vol, uint : unit", weak => 1 },
+ sig => "vol, uint : unit" },
{ name => "virStorageVolLookupByName",
- sig => "pool, string : vol from pool", weak => 1 },
+ sig => "pool, string : vol from pool" },
{ name => "virStorageVolLookupByKey",
- sig => "conn, string : vol", weak => 1 },
+ sig => "conn, string : vol" },
{ name => "virStorageVolLookupByPath",
- sig => "conn, string : vol", weak => 1 },
+ sig => "conn, string : vol" },
{ name => "virStorageVolCreateXML",
- sig => "pool, string, 0U : vol from pool", weak => 1 },
+ sig => "pool, string, 0U : vol from pool" },
{ name => "virStorageVolGetXMLDesc",
- sig => "vol, 0U : string", weak => 1 },
+ sig => "vol, 0U : string" },
{ name => "virStorageVolGetPath",
- sig => "vol : string", weak => 1 },
+ sig => "vol : string" },
{ name => "virStorageVolGetKey",
- sig => "vol : static string", weak => 1 },
+ sig => "vol : static string" },
{ name => "virStorageVolGetName",
- sig => "vol : static string", weak => 1 },
+ sig => "vol : static string" },
{ name => "virStoragePoolLookupByVolume",
- sig => "vol : pool from vol", weak => 1 },
+ sig => "vol : pool from vol" },
);
@@ -270,115 +270,6 @@ sub short_name_to_c_type
}
}
-# Generate a C signature for the original function. Used when building
-# weak bindings.
-
-sub gen_c_signature
-{
- my $sig = shift;
- my $c_name = shift;
-
- if ($sig =~ /^(\w+) : string$/) {
- my $c_type = short_name_to_c_type ($1);
- "char *$c_name ($c_type $1)"
- } elsif ($sig =~ /^(\w+) : static string$/) {
- my $c_type = short_name_to_c_type ($1);
- "const char *$c_name ($c_type $1)"
- } elsif ($sig =~ /^(\w+) : int$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1)"
- } elsif ($sig =~ /^(\w+) : uuid$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1, unsigned char *)"
- } elsif ($sig =~ /^(\w+) : uuid string$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1, char *)"
- } elsif ($sig =~ /^(\w+) : bool$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1, int *r)"
- } elsif ($sig =~ /^(\w+), bool : unit$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1, int b)"
- } elsif ($sig eq "conn, int : int array") {
- "int $c_name (virConnectPtr conn, int *ids, int maxids)"
- } elsif ($sig =~ /^(\w+), int : string array$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1, char **const names, int maxnames)"
- } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "U" ? "unsigned " : "";
- "char *$c_name ($c_type $1, $unsigned int flags)"
- } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "U" ? "unsigned " : "";
- "int $c_name ($c_type $1, $unsigned int flags)"
- } elsif ($sig =~ /^(\w+) : unit$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1)"
- } elsif ($sig =~ /^(\w+) : free$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1)"
- } elsif ($sig =~ /^(\w+), string : unit$/) {
- my $c_type = short_name_to_c_type ($1);
- "int $c_name ($c_type $1, const char *str)"
- } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "U" ? "unsigned " : "";
- "int $c_name ($c_type $1, const char *str, ${unsigned}int flags)"
- } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
- my $c_type = short_name_to_c_type ($1);
- my $c_ret_type = short_name_to_c_type ($2);
- "$c_ret_type $c_name ($c_type $1, const char *str)"
- } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "U" ? "unsigned " : "";
- my $c_ret_type = short_name_to_c_type ($3);
- "$c_ret_type $c_name ($c_type $1, const char *str, ${unsigned}int flags)"
- } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "u" ? "unsigned " : "";
- "int $c_name ($c_type $1, ${unsigned}int i)"
- } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "u" ? "unsigned " : "";
- my $c_ret_type = short_name_to_c_type ($3);
- "$c_ret_type $c_name ($c_type $1, ${unsigned}int i)"
- } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
- my $c_type = short_name_to_c_type ($1);
- my $c_ret_type = short_name_to_c_type ($2);
- "$c_ret_type $c_name ($c_type $1, const unsigned char *str)"
- } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "U" ? "unsigned " : "";
- my $c_ret_type = short_name_to_c_type ($3);
- "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
- } elsif ($sig =~ /^(\w+) : (\w+)$/) {
- my $c_type = short_name_to_c_type ($1);
- my $c_ret_type = short_name_to_c_type ($2);
- "$c_ret_type $c_name ($c_type $1)"
- } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
- my $c_type = short_name_to_c_type ($1);
- my $c_ret_type = short_name_to_c_type ($2);
- "$c_ret_type $c_name ($c_type $1, const char *str)"
- } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "U" ? "unsigned " : "";
- my $c_ret_type = short_name_to_c_type ($3);
- "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)"
- } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) {
- my $c_type = short_name_to_c_type ($1);
- my $unsigned = $2 eq "U" ? "unsigned " : "";
- my $c_ret_type = short_name_to_c_type ($3);
- "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
- } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
- my $c_type = short_name_to_c_type ($1);
- my $c_ret_type = short_name_to_c_type ($2);
- "$c_ret_type $c_name ($c_type $1)"
- } else {
- die "unknown signature $sig"
- }
-}
-
# OCaml argument names.
sub gen_arg_names
@@ -749,7 +640,7 @@ sub gen_c_code
int r;
NONBLOCKING (r = $c_name ($1, i));
- CHECK_ERROR (!r, conn, \"$c_name\");
+ CHECK_ERROR (r == -1, conn, \"$c_name\");
CAMLreturn (Val_unit);
"
@@ -883,7 +774,6 @@ sub gen_c_code
foreach my $function (@functions) {
my $c_name = $function->{name};
- my $is_weak = $function->{weak};
my $sig = $function->{sig};
#print "generating $c_name with sig \"$sig\" ...\n";
@@ -911,20 +801,6 @@ foreach my $function (@functions) {
END
- # Generate a full function prototype if the function is weak.
- my $have_name = "HAVE_" . uc ($c_name);
- if ($is_weak) {
- my $c_sig = gen_c_signature ($sig, $c_name);
- print F <<END;
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef $have_name
-extern $c_sig __attribute__((weak));
-#endif
-#endif
-
-END
- }
-
my @arg_names = gen_arg_names ($sig);
my $nr_arg_names = scalar @arg_names;
my $arg_names = join ", ", @arg_names;
@@ -938,31 +814,9 @@ $c_external_name ($arg_names_as_values)
CAMLparam$nr_arg_names ($arg_names);
END
- # If weak, check the function exists at compile time or runtime.
- if ($is_weak) {
- print F <<END;
-#ifndef $have_name
- /* Symbol $c_name not found at compile time. */
- not_supported ("$c_name");
- CAMLnoreturn;
-#else
- /* Check that the symbol $c_name
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK ($c_name);
-END
- }
-
# Generate the internals of the function.
print F (gen_c_code ($sig, $c_name));
- # Finish off weak #ifdef.
- if ($is_weak) {
- print F <<END;
-#endif
-END
- }
-
# Finish off the function.
print F <<END;
}
diff --git a/libvirt/libvirt.ml b/libvirt/libvirt.ml
index 53c5bb4..9c9368a 100644
--- a/libvirt/libvirt.ml
+++ b/libvirt/libvirt.ml
@@ -100,6 +100,8 @@ struct
let cpu_usable cpumaps maplen vcpu cpu =
Char.code cpumaps.[vcpu*maplen + cpu/8] land (1 lsl (cpu mod 8)) <> 0
+ external set_keep_alive : [>`R] t -> int -> int -> unit = "ocaml_libvirt_connect_set_keep_alive"
+
external const : [>`R] t -> ro t = "%identity"
end
@@ -417,7 +419,7 @@ struct
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_cpu_stats : [>`R] t -> int -> typed_param list array = "ocaml_libvirt_domain_get_cpu_stats"
+ external get_cpu_stats : [>`R] t -> typed_param list array = "ocaml_libvirt_domain_get_cpu_stats"
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"
@@ -481,6 +483,771 @@ struct
map_ignore_errors (fun dom -> (dom, get_info dom)) doms
end
+module Event =
+struct
+
+ module Defined = struct
+ type t = [
+ | `Added
+ | `Updated
+ | `Unknown of int
+ ]
+
+ let to_string = function
+ | `Added -> "Added"
+ | `Updated -> "Updated"
+ | `Unknown x -> Printf.sprintf "Unknown Defined.detail: %d" x
+
+ let make = function
+ | 0 -> `Added
+ | 1 -> `Updated
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ module Undefined = struct
+ type t = [
+ | `Removed
+ | `Unknown of int
+ ]
+
+ let to_string = function
+ | `Removed -> "UndefinedRemoved"
+ | `Unknown x -> Printf.sprintf "Unknown Undefined.detail: %d" x
+
+ let make = function
+ | 0 -> `Removed
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ module Started = struct
+ type t = [
+ | `Booted
+ | `Migrated
+ | `Restored
+ | `FromSnapshot
+ | `Wakeup
+ | `Unknown of int
+ ]
+
+ let to_string = function
+ | `Booted -> "Booted"
+ | `Migrated -> "Migrated"
+ | `Restored -> "Restored"
+ | `FromSnapshot -> "FromSnapshot"
+ | `Wakeup -> "Wakeup"
+ | `Unknown x -> Printf.sprintf "Unknown Started.detail: %d" x
+
+ let make = function
+ | 0 -> `Booted
+ | 1 -> `Migrated
+ | 2 -> `Restored
+ | 3 -> `FromSnapshot
+ | 4 -> `Wakeup
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ module Suspended = struct
+ type t = [
+ | `Paused
+ | `Migrated
+ | `IOError
+ | `Watchdog
+ | `Restored
+ | `FromSnapshot
+ | `APIError
+ | `Unknown of int (* newer libvirt *)
+ ]
+
+ let to_string = function
+ | `Paused -> "Paused"
+ | `Migrated -> "Migrated"
+ | `IOError -> "IOError"
+ | `Watchdog -> "Watchdog"
+ | `Restored -> "Restored"
+ | `FromSnapshot -> "FromSnapshot"
+ | `APIError -> "APIError"
+ | `Unknown x -> Printf.sprintf "Unknown Suspended.detail: %d" x
+
+ let make = function
+ | 0 -> `Paused
+ | 1 -> `Migrated
+ | 2 -> `IOError
+ | 3 -> `Watchdog
+ | 4 -> `Restored
+ | 5 -> `FromSnapshot
+ | 6 -> `APIError
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ module Resumed = struct
+ type t = [
+ | `Unpaused
+ | `Migrated
+ | `FromSnapshot
+ | `Unknown of int (* newer libvirt *)
+ ]
+
+ let to_string = function
+ | `Unpaused -> "Unpaused"
+ | `Migrated -> "Migrated"
+ | `FromSnapshot -> "FromSnapshot"
+ | `Unknown x -> Printf.sprintf "Unknown Resumed.detail: %d" x
+
+ let make = function
+ | 0 -> `Unpaused
+ | 1 -> `Migrated
+ | 2 -> `FromSnapshot
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ module Stopped = struct
+ type t = [
+ | `Shutdown
+ | `Destroyed
+ | `Crashed
+ | `Migrated
+ | `Saved
+ | `Failed
+ | `FromSnapshot
+ | `Unknown of int
+ ]
+ let to_string = function
+ | `Shutdown -> "Shutdown"
+ | `Destroyed -> "Destroyed"
+ | `Crashed -> "Crashed"
+ | `Migrated -> "Migrated"
+ | `Saved -> "Saved"
+ | `Failed -> "Failed"
+ | `FromSnapshot -> "FromSnapshot"
+ | `Unknown x -> Printf.sprintf "Unknown Stopped.detail: %d" x
+
+ let make = function
+ | 0 -> `Shutdown
+ | 1 -> `Destroyed
+ | 2 -> `Crashed
+ | 3 -> `Migrated
+ | 4 -> `Saved
+ | 5 -> `Failed
+ | 6 -> `FromSnapshot
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ module PM_suspended = struct
+ type t = [
+ | `Memory
+ | `Disk
+ | `Unknown of int (* newer libvirt *)
+ ]
+
+ let to_string = function
+ | `Memory -> "Memory"
+ | `Disk -> "Disk"
+ | `Unknown x -> Printf.sprintf "Unknown PM_suspended.detail: %d" x
+
+ let make = function
+ | 0 -> `Memory
+ | 1 -> `Disk
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ let string_option x = match x with
+ | None -> "None"
+ | Some x' -> "Some " ^ x'
+
+ module Lifecycle = struct
+ type t = [
+ | `Defined of Defined.t
+ | `Undefined of Undefined.t
+ | `Started of Started.t
+ | `Suspended of Suspended.t
+ | `Resumed of Resumed.t
+ | `Stopped of Stopped.t
+ | `Shutdown (* no detail defined yet *)
+ | `PMSuspended of PM_suspended.t
+ | `Unknown of int (* newer libvirt *)
+ ]
+
+ let to_string = function
+ | `Defined x -> "Defined " ^ (Defined.to_string x)
+ | `Undefined x -> "Undefined " ^ (Undefined.to_string x)
+ | `Started x -> "Started " ^ (Started.to_string x)
+ | `Suspended x -> "Suspended " ^ (Suspended.to_string x)
+ | `Resumed x -> "Resumed " ^ (Resumed.to_string x)
+ | `Stopped x -> "Stopped " ^ (Stopped.to_string x)
+ | `Shutdown -> "Shutdown"
+ | `PMSuspended x -> "PMSuspended " ^ (PM_suspended.to_string x)
+ | `Unknown x -> Printf.sprintf "Unknown Lifecycle event: %d" x
+
+ let make (ty, detail) = match ty with
+ | 0 -> `Defined (Defined.make detail)
+ | 1 -> `Undefined (Undefined.make detail)
+ | 2 -> `Started (Started.make detail)
+ | 3 -> `Suspended (Suspended.make detail)
+ | 4 -> `Resumed (Resumed.make detail)
+ | 5 -> `Stopped (Stopped.make detail)
+ | 6 -> `Shutdown
+ | 7 -> `PMSuspended (PM_suspended.make detail)
+ | x -> `Unknown x
+ end
+
+ module Reboot = struct
+ type t = unit
+
+ let to_string _ = "()"
+
+ let make () = ()
+ end
+
+ module Rtc_change = struct
+ type t = int64
+
+ let to_string = Int64.to_string
+
+ let make x = x
+ end
+
+ module Watchdog = struct
+ type t = [
+ | `None
+ | `Pause
+ | `Reset
+ | `Poweroff
+ | `Shutdown
+ | `Debug
+ | `Unknown of int
+ ]
+
+ let to_string = function
+ | `None -> "None"
+ | `Pause -> "Pause"
+ | `Reset -> "Reset"
+ | `Poweroff -> "Poweroff"
+ | `Shutdown -> "Shutdown"
+ | `Debug -> "Debug"
+ | `Unknown x -> Printf.sprintf "Unknown watchdog_action: %d" x
+
+ let make = function
+ | 0 -> `None
+ | 1 -> `Pause
+ | 2 -> `Reset
+ | 3 -> `Poweroff
+ | 4 -> `Shutdown
+ | 5 -> `Debug
+ | x -> `Unknown x (* newer libvirt *)
+ end
+
+ module Io_error = struct
+ type action = [
+ | `None
+ | `Pause
+ | `Report
+ | `Unknown of int (* newer libvirt *)
+ ]
+
+ let string_of_action = function
+ | `None -> "None"
+ | `Pause -> "Pause"
+ | `Report -> "Report"
+ | `Unknown x -> Printf.sprintf "Unknown Io_error.action: %d" x
+
+ let action_of_int = function
+ | 0 -> `None
+ | 1 -> `Pause
+ | 2 -> `Report
+ | x -> `Unknown x
+
+ type t = {
+ src_path: string option;
+ dev_alias: string option;
+ action: action;
+ reason: string option;
+ }
+
+ let to_string t = Printf.sprintf
+ "{ Io_error.src_path = %s; dev_alias = %s; action = %s; reason = %s }"
+ (string_option t.src_path)
+ (string_option t.dev_alias)
+ (string_of_action t.action)
+ (string_option t.reason)
+
+ let make (src_path, dev_alias, action, reason) = {
+ src_path = src_path;
+ dev_alias = dev_alias;
+ action = action_of_int action;
+ reason = reason;
+ }
+
+ let make_noreason (src_path, dev_alias, action) =
+ make (src_path, dev_alias, action, None)
+ end
+
+ module Graphics_address = struct
+ type family = [
+ | `Ipv4
+ | `Ipv6
+ | `Unix
+ | `Unknown of int (* newer libvirt *)
+ ]
+
+ let string_of_family = function
+ | `Ipv4 -> "IPv4"
+ | `Ipv6 -> "IPv6"
+ | `Unix -> "UNIX"
+ | `Unknown x -> Printf.sprintf "Unknown Graphics_address.family: %d" x
+
+ let family_of_int = function
+ (* no zero *)
+ | 1 -> `Ipv4
+ | 2 -> `Ipv6
+ | 3 -> `Unix
+ | x -> `Unknown x
+
+ type t = {
+ family: family; (** Address family *)
+ node: string option; (** Address of node (eg IP address, or UNIX path *)
+ service: string option; (** Service name/number (eg TCP port, or NULL) *)
+ }
+
+ let to_string t = Printf.sprintf
+ "{ family = %s; node = %s; service = %s }"
+ (string_of_family t.family)
+ (string_option t.node)
+ (string_option t.service)
+
+ let make (family, node, service) = {
+ family = family_of_int family;
+ node = node;
+ service = service;
+ }
+ end
+
+ module Graphics_subject = struct
+ type identity = {
+ ty: string option;
+ name: string option;
+ }
+
+ let string_of_identity t = Printf.sprintf
+ "{ ty = %s; name = %s }"
+ (string_option t.ty)
+ (string_option t.name)
+
+ type t = identity list
+
+ let to_string ts =
+ "[ " ^ (String.concat "; " (List.map string_of_identity ts)) ^ " ]"
+
+ let make xs =
+ List.map (fun (ty, name) -> { ty = ty; name = name })
+ (Array.to_list xs)
+ end
+
+ module Graphics = struct
+ type phase = [
+ | `Connect
+ | `Initialize
+ | `Disconnect
+ | `Unknown of int (** newer libvirt *)
+ ]
+
+ let string_of_phase = function
+ | `Connect -> "Connect"
+ | `Initialize -> "Initialize"
+ | `Disconnect -> "Disconnect"
+ | `Unknown x -> Printf.sprintf "Unknown Graphics.phase: %d" x
+
+ let phase_of_int = function
+ | 0 -> `Connect
+ | 1 -> `Initialize
+ | 2 -> `Disconnect
+ | x -> `Unknown x
+
+ type t = {
+ phase: phase; (** the phase of the connection *)
+ local: Graphics_address.t; (** the local server address *)
+ remote: Graphics_address.t; (** the remote client address *)
+ auth_scheme: string option; (** the authentication scheme activated *)
+ subject: Graphics_subject.t; (** the authenticated subject (user) *)
+ }
+
+ let to_string t =
+ let phase = Printf.sprintf "phase = %s"
+ (string_of_phase t.phase) in
+ let local = Printf.sprintf "local = %s"
+ (Graphics_address.to_string t.local) in
+ let remote = Printf.sprintf "remote = %s"
+ (Graphics_address.to_string t.remote) in
+ let auth_scheme = Printf.sprintf "auth_scheme = %s"
+ (string_option t.auth_scheme) in
+ let subject = Printf.sprintf "subject = %s"
+ (Graphics_subject.to_string t.subject) in
+ "{ " ^ (String.concat "; " [ phase; local; remote; auth_scheme; subject ]) ^ " }"
+
+ let make (phase, local, remote, auth_scheme, subject) = {
+ phase = phase_of_int phase;
+ local = Graphics_address.make local;
+ remote = Graphics_address.make remote;
+ auth_scheme = auth_scheme;
+ subject = Graphics_subject.make subject;
+ }
+ end
+
+ module Control_error = struct
+ type t = unit
+
+ let to_string () = "()"
+
+ let make () = ()
+ end
+
+ module Block_job = struct
+ type ty = [
+ | `KnownUnknown (* explicitly named UNKNOWN in the spec *)
+ | `Pull
+ | `Copy
+ | `Commit
+ | `Unknown of int (* newer libvirt *)
+ ]
+
+ let string_of_ty = function
+ | `KnownUnknown -> "KnownUnknown"
+ | `Pull -> "Pull"
+ | `Copy -> "Copy"
+ | `Commit -> "Commit"
+ | `Unknown x -> Printf.sprintf "Unknown Block_job.ty: %d" x
+
+ let ty_of_int = function
+ | 0 -> `KnownUnknown
+ | 1 -> `Pull
+ | 2 -> `Copy
+ | 3 -> `Commit
+ | x -> `Unknown x (* newer libvirt *)
+
+ type status = [
+ | `Completed
+ | `Failed
+ | `Cancelled
+ | `Ready
+ | `Unknown of int
+ ]
+
+ let string_of_status = function
+ | `Completed -> "Completed"
+ | `Failed -> "Failed"
+ | `Cancelled -> "Cancelled"
+ | `Ready -> "Ready"
+ | `Unknown x -> Printf.sprintf "Unknown Block_job.status: %d" x
+
+ let status_of_int = function
+ | 0 -> `Completed
+ | 1 -> `Failed
+ | 2 -> `Cancelled
+ | 3 -> `Ready
+ | x -> `Unknown x
+
+ type t = {
+ disk: string option;
+ ty: ty;
+ status: status;
+ }
+
+ let to_string t = Printf.sprintf "{ disk = %s; ty = %s; status = %s }"
+ (string_option t.disk)
+ (string_of_ty t.ty)
+ (string_of_status t.status)
+
+ let make (disk, ty, status) = {
+ disk = disk;
+ ty = ty_of_int ty;
+ status = status_of_int ty;
+ }
+ end
+
+ module Disk_change = struct
+ type reason = [
+ | `MissingOnStart
+ | `Unknown of int
+ ]
+
+ let string_of_reason = function
+ | `MissingOnStart -> "MissingOnStart"
+ | `Unknown x -> Printf.sprintf "Unknown Disk_change.reason: %d" x
+
+ let reason_of_int = function
+ | 0 -> `MissingOnStart
+ | x -> `Unknown x
+
+ type t = {
+ old_src_path: string option;
+ new_src_path: string option;
+ dev_alias: string option;
+ reason: reason;
+ }
+
+ let to_string t =
+ let o = Printf.sprintf "old_src_path = %s" (string_option t.old_src_path) in
+ let n = Printf.sprintf "new_src_path = %s" (string_option t.new_src_path) in
+ let d = Printf.sprintf "dev_alias = %s" (string_option t.dev_alias) in
+ let r = string_of_reason t.reason in
+ "{ " ^ (String.concat "; " [ o; n; d; r ]) ^ " }"
+
+ let make (o, n, d, r) = {
+ old_src_path = o;
+ new_src_path = n;
+ dev_alias = d;
+ reason = reason_of_int r;
+ }
+ end
+
+ module Tray_change = struct
+ type reason = [
+ | `Open
+ | `Close
+ | `Unknown of int
+ ]
+
+ let string_of_reason = function
+ | `Open -> "Open"
+ | `Close -> "Close"
+ | `Unknown x -> Printf.sprintf "Unknown Tray_change.reason: %d" x
+
+ let reason_of_int = function
+ | 0 -> `Open
+ | 1 -> `Close
+ | x -> `Unknown x
+
+ type t = {
+ dev_alias: string option;
+ reason: reason;
+ }
+
+ let to_string t = Printf.sprintf
+ "{ dev_alias = %s; reason = %s }"
+ (string_option t.dev_alias)
+ (string_of_reason t.reason)
+
+ let make (dev_alias, reason) = {
+ dev_alias = dev_alias;
+ reason = reason_of_int reason;
+ }
+ end
+
+ module PM_wakeup = struct
+ type reason = [
+ | `Unknown of int
+ ]
+
+ type t = reason
+
+ let to_string = function
+ | `Unknown x -> Printf.sprintf "Unknown PM_wakeup.reason: %d" x
+
+ let make x = `Unknown x
+ end
+
+ module PM_suspend = struct
+ type reason = [
+ | `Unknown of int
+ ]
+
+ type t = reason
+
+ let to_string = function
+ | `Unknown x -> Printf.sprintf "Unknown PM_suspend.reason: %d" x
+
+ let make x = `Unknown x
+ end
+
+ module Balloon_change = struct
+ type t = int64
+
+ let to_string = Int64.to_string
+ let make x = x
+ end
+
+ module PM_suspend_disk = struct
+ type reason = [
+ | `Unknown of int
+ ]
+
+ type t = reason
+
+ let to_string = function
+ | `Unknown x -> Printf.sprintf "Unknown PM_suspend_disk.reason: %d" x
+
+ let make x = `Unknown x
+ end
+
+ type callback =
+ | Lifecycle of ([`R] Domain.t -> Lifecycle.t -> unit)
+ | Reboot of ([`R] Domain.t -> Reboot.t -> unit)
+ | RtcChange of ([`R] Domain.t -> Rtc_change.t -> unit)
+ | Watchdog of ([`R] Domain.t -> Watchdog.t -> unit)
+ | IOError of ([`R] Domain.t -> Io_error.t -> unit)
+ | Graphics of ([`R] Domain.t -> Graphics.t -> unit)
+ | IOErrorReason of ([`R] Domain.t -> Io_error.t -> unit)
+ | ControlError of ([`R] Domain.t -> Control_error.t -> unit)
+ | BlockJob of ([`R] Domain.t -> Block_job.t -> unit)
+ | DiskChange of ([`R] Domain.t -> Disk_change.t -> unit)
+ | TrayChange of ([`R] Domain.t -> Tray_change.t -> unit)
+ | PMWakeUp of ([`R] Domain.t -> PM_wakeup.t -> unit)
+ | PMSuspend of ([`R] Domain.t -> PM_suspend.t -> unit)
+ | BalloonChange of ([`R] Domain.t -> Balloon_change.t -> unit)
+ | PMSuspendDisk of ([`R] Domain.t -> PM_suspend_disk.t -> unit)
+
+ type callback_id = int64
+
+ let fresh_callback_id =
+ let next = ref 0L in
+ fun () ->
+ let result = !next in
+ next := Int64.succ !next;
+ result
+
+ let make_table value_name =
+ let table = Hashtbl.create 16 in
+ let callback callback_id generic x =
+ if Hashtbl.mem table callback_id
+ then Hashtbl.find table callback_id generic x in
+ let _ = Callback.register value_name callback in
+ table
+
+ let u_table = make_table "Libvirt.u_callback"
+ let i_table = make_table "Libvirt.i_callback"
+ let i64_table = make_table "Libvirt.i64_callback"
+ let i_i_table = make_table "Libvirt.i_i_callback"
+ let s_i_table = make_table "Libvirt.s_i_callback"
+ let s_i_i_table = make_table "Libvirt.s_i_i_callback"
+ let s_s_i_table = make_table "Libvirt.s_s_i_callback"
+ let s_s_i_s_table = make_table "Libvirt.s_s_i_s_callback"
+ let s_s_s_i_table = make_table "Libvirt.s_s_s_i_callback"
+ let i_ga_ga_s_gs_table = make_table "Libvirt.i_ga_ga_s_gs_callback"
+
+ external register_default_impl : unit -> unit = "ocaml_libvirt_event_register_default_impl"
+
+ external run_default_impl : unit -> unit = "ocaml_libvirt_event_run_default_impl"
+
+ external register_any' : 'a Connect.t -> 'a Domain.t option -> callback -> callback_id -> int = "ocaml_libvirt_connect_domain_event_register_any"
+
+ external deregister_any' : 'a Connect.t -> int -> unit = "ocaml_libvirt_connect_domain_event_deregister_any"
+
+ let our_id_to_libvirt_id = Hashtbl.create 16
+
+ let register_any conn ?dom callback =
+ let id = fresh_callback_id () in
+ begin match callback with
+ | Lifecycle f ->
+ Hashtbl.add i_i_table id (fun dom x ->
+ f dom (Lifecycle.make x)
+ )
+ | Reboot f ->
+ Hashtbl.add u_table id (fun dom x ->
+ f dom (Reboot.make x)
+ )
+ | RtcChange f ->
+ Hashtbl.add i64_table id (fun dom x ->
+ f dom (Rtc_change.make x)
+ )
+ | Watchdog f ->
+ Hashtbl.add i_table id (fun dom x ->
+ f dom (Watchdog.make x)
+ )
+ | IOError f ->
+ Hashtbl.add s_s_i_table id (fun dom x ->
+ f dom (Io_error.make_noreason x)
+ )
+ | Graphics f ->
+ Hashtbl.add i_ga_ga_s_gs_table id (fun dom x ->
+ f dom (Graphics.make x)
+ )
+ | IOErrorReason f ->
+ Hashtbl.add s_s_i_s_table id (fun dom x ->
+ f dom (Io_error.make x)
+ )
+ | ControlError f ->
+ Hashtbl.add u_table id (fun dom x ->
+ f dom (Control_error.make x)
+ )
+ | BlockJob f ->
+ Hashtbl.add s_i_i_table id (fun dom x ->
+ f dom (Block_job.make x)
+ )
+ | DiskChange f ->
+ Hashtbl.add s_s_s_i_table id (fun dom x ->
+ f dom (Disk_change.make x)
+ )
+ | TrayChange f ->
+ Hashtbl.add s_i_table id (fun dom x ->
+ f dom (Tray_change.make x)
+ )
+ | PMWakeUp f ->
+ Hashtbl.add i_table id (fun dom x ->
+ f dom (PM_wakeup.make x)
+ )
+ | PMSuspend f ->
+ Hashtbl.add i_table id (fun dom x ->
+ f dom (PM_suspend.make x)
+ )
+ | BalloonChange f ->
+ Hashtbl.add i64_table id (fun dom x ->
+ f dom (Balloon_change.make x)
+ )
+ | PMSuspendDisk f ->
+ Hashtbl.add i_table id (fun dom x ->
+ f dom (PM_suspend_disk.make x)
+ )
+ end;
+ let libvirt_id = register_any' conn dom callback id in
+ Hashtbl.replace our_id_to_libvirt_id id libvirt_id;
+ id
+
+ let deregister_any conn id =
+ if Hashtbl.mem our_id_to_libvirt_id id then begin
+ let libvirt_id = Hashtbl.find our_id_to_libvirt_id id in
+ deregister_any' conn libvirt_id
+ end;
+ Hashtbl.remove our_id_to_libvirt_id id;
+ Hashtbl.remove u_table id;
+ Hashtbl.remove i_table id;
+ Hashtbl.remove i64_table id;
+ Hashtbl.remove i_i_table id;
+ Hashtbl.remove s_i_table id;
+ Hashtbl.remove s_i_i_table id;
+ Hashtbl.remove s_s_i_table id;
+ Hashtbl.remove s_s_i_s_table id;
+ Hashtbl.remove s_s_s_i_table id;
+ Hashtbl.remove i_ga_ga_s_gs_table id
+
+ let timeout_table = Hashtbl.create 16
+ let _ =
+ let callback x =
+ if Hashtbl.mem timeout_table x
+ then Hashtbl.find timeout_table x () in
+ Callback.register "Libvirt.timeout_callback" callback
+
+ type timer_id = int64
+
+ external add_timeout' : 'a Connect.t -> int -> int64 -> int = "ocaml_libvirt_event_add_timeout"
+
+ external remove_timeout' : 'a Connect.t -> int -> unit = "ocaml_libvirt_event_remove_timeout"
+
+ let our_id_to_timer_id = Hashtbl.create 16
+ let add_timeout conn ms fn =
+ let id = fresh_callback_id () in
+ Hashtbl.add timeout_table id fn;
+ let timer_id = add_timeout' conn ms id in
+ Hashtbl.add our_id_to_timer_id id timer_id;
+ id
+
+ let remove_timeout conn id =
+ if Hashtbl.mem our_id_to_timer_id id then begin
+ let timer_id = Hashtbl.find our_id_to_timer_id id in
+ remove_timeout' conn timer_id
+ end;
+ Hashtbl.remove our_id_to_timer_id id;
+ Hashtbl.remove timeout_table id
+end
+
module Network =
struct
type 'rw t
@@ -536,7 +1303,7 @@ struct
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 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"
@@ -562,8 +1329,8 @@ struct
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 create_xml : [>`W] Pool.t -> xml -> unit = "ocaml_libvirt_storage_vol_create_xml"
+ external delete : [>`W] t -> vol_delete_flags -> unit = "ocaml_libvirt_storage_vol_delete"
external free : [>`R] t -> unit = "ocaml_libvirt_storage_vol_free"
external const : [>`R] t -> ro t = "%identity"
end
diff --git a/libvirt/libvirt.mli b/libvirt/libvirt.mli
index 0913a63..36cd113 100644
--- a/libvirt/libvirt.mli
+++ b/libvirt/libvirt.mli
@@ -142,18 +142,11 @@ printf "uri = %s\n%!" uri
{3 Backwards and forwards compatibility}
- OCaml-libvirt is backwards and forwards compatible with
- any libvirt >= 0.2.1. One consequence of this is that
- your program can dynamically link to a {i newer} version of
- libvirt than it was compiled with, and it should still
- work.
-
- When we link to an older version of libvirt.so, there may
- be missing functions. If ocaml-libvirt was compiled with
- gcc, then these are turned into OCaml {!Libvirt.Not_supported}
- exceptions.
-
- We don't support libvirt < 0.2.1, and never will so don't ask us.
+ OCaml-libvirt requires libvirt version 1.0.2 or later. Future
+ releases of OCaml-libvirt will use newer features of libvirt
+ and therefore will require later versions of libvirt. It is always
+ possible to dynamically link your application against a newer
+ libvirt than OCaml-libvirt was originally compiled against.
{3 Get list of domains and domain infos}
@@ -391,6 +384,14 @@ sig
(** [cpu_usable cpumaps maplen vcpu cpu] checks returns true iff the
[cpu] is usable by [vcpu]. *)
+ val set_keep_alive : [>`R] t -> int -> int -> unit
+ (** [set_keep_alive conn interval count] starts sending keepalive
+ messages after [interval] seconds of inactivity and consider the
+ connection to be broken when no response is received after [count]
+ keepalive messages.
+ Note: the client has to implement and run an event loop to
+ be able to use keep-alive messages. *)
+
external const : [>`R] t -> ro t = "%identity"
(** [const conn] turns a read/write connection into a read-only
connection. Note that the opposite operation is impossible.
@@ -559,8 +560,8 @@ sig
for a domain. See the libvirt documentation for details
of the array and bitmap returned from this function.
*)
- val get_cpu_stats : [>`R] t -> int -> typed_param list array
- (** [get_pcpu_stats dom nr_pcpu] returns the physical CPU stats
+ val get_cpu_stats : [>`R] t -> typed_param list array
+ (** [get_pcpu_stats dom] returns the physical CPU stats
for a domain. See the libvirt documentation for details.
*)
val get_max_vcpus : [>`R] t -> int
@@ -637,6 +638,361 @@ end
(** Module dealing with domains. [Domain.t] is the
domain object. *)
+module Event :
+sig
+
+ module Defined : sig
+ type t = [
+ | `Added (** Newly created config file *)
+ | `Updated (** Changed config file *)
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Undefined : sig
+ type t = [
+ | `Removed (** Deleted the config file *)
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Started : sig
+ type t = [
+ | `Booted (** Normal startup from boot *)
+ | `Migrated (** Incoming migration from another host *)
+ | `Restored (** Restored from a state file *)
+ | `FromSnapshot (** Restored from snapshot *)
+ | `Wakeup (** Started due to wakeup event *)
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Suspended : sig
+ type t = [
+ | `Paused (** Normal suspend due to admin pause *)
+ | `Migrated (** Suspended for offline migration *)
+ | `IOError (** Suspended due to a disk I/O error *)
+ | `Watchdog (** Suspended due to a watchdog firing *)
+ | `Restored (** Restored from paused state file *)
+ | `FromSnapshot (** Restored from paused snapshot *)
+ | `APIError (** suspended after failure during libvirt API call *)
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Resumed : sig
+ type t = [
+ | `Unpaused (** Normal resume due to admin unpause *)
+ | `Migrated (** Resumed for completion of migration *)
+ | `FromSnapshot (** Resumed from snapshot *)
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Stopped : sig
+ type t = [
+ | `Shutdown (** Normal shutdown *)
+ | `Destroyed (** Forced poweroff from host *)
+ | `Crashed (** Guest crashed *)
+ | `Migrated (** Migrated off to another host *)
+ | `Saved (** Saved to a state file *)
+ | `Failed (** Host emulator/mgmt failed *)
+ | `FromSnapshot (** offline snapshot loaded *)
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module PM_suspended : sig
+ type t = [
+ | `Memory (** Guest was PM suspended to memory *)
+ | `Disk (** Guest was PM suspended to disk *)
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Lifecycle : sig
+ type t = [
+ | `Defined of Defined.t
+ | `Undefined of Undefined.t
+ | `Started of Started.t
+ | `Suspended of Suspended.t
+ | `Resumed of Resumed.t
+ | `Stopped of Stopped.t
+ | `Shutdown (* no detail defined yet *)
+ | `PMSuspended of PM_suspended.t
+ | `Unknown of int
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Reboot : sig
+ type t = unit
+
+ val to_string: t -> string
+ end
+
+ module Rtc_change : sig
+ type t = int64
+
+ val to_string: t -> string
+ end
+
+ module Watchdog : sig
+ type t = [
+ | `None (** No action, watchdog ignored *)
+ | `Pause (** Guest CPUs are paused *)
+ | `Reset (** Guest CPUs are reset *)
+ | `Poweroff (** Guest is forcably powered off *)
+ | `Shutdown (** Guest is requested to gracefully shutdown *)
+ | `Debug (** No action, a debug message logged *)
+ | `Unknown of int (** newer libvirt *)
+ ]
+
+ val to_string: t -> string
+ end
+
+ module Io_error : sig
+ (** Represents both IOError and IOErrorReason *)
+ type action = [
+ | `None (** No action, IO error ignored *)
+ | `Pause (** Guest CPUs are paused *)
+ | `Report (** IO error reported to guest OS *)
+ | `Unknown of int (** newer libvirt *)
+ ]
+
+ type t = {
+ src_path: string option; (** The host file on which the I/O error occurred *)
+ dev_alias: string option; (** The guest device alias associated with the path *)
+ action: action; (** The action that is to be taken due to the IO error *)
+ reason: string option; (** The cause of the IO error *)
+ }
+
+ val to_string: t -> string
+ end
+
+ module Graphics_address : sig
+ type family = [
+ | `Ipv4 (** IPv4 address *)
+ | `Ipv6 (** IPv6 address *)
+ | `Unix (** UNIX socket path *)
+ | `Unknown of int (** newer libvirt *)
+ ]
+
+ type t = {
+ family: family; (** Address family *)
+ node: string option; (** Address of node (eg IP address, or UNIX path *)
+ service: string option; (** Service name/number (eg TCP port, or NULL) *)
+ }
+
+ val to_string: t -> string
+ end
+
+ module Graphics_subject : sig
+ type identity = {
+ ty: string option; (** Type of identity *)
+ name: string option; (** Identity value *)
+ }
+
+ type t = identity list
+
+ val to_string: t -> string
+ end
+
+ module Graphics : sig
+ type phase = [
+ | `Connect (** Initial socket connection established *)
+ | `Initialize (** Authentication & setup completed *)
+ | `Disconnect (** Final socket disconnection *)
+ | `Unknown of int (** newer libvirt *)
+ ]
+
+ type t = {
+ phase: phase; (** the phase of the connection *)
+ local: Graphics_address.t; (** the local server address *)
+ remote: Graphics_address.t; (** the remote client address *)
+ auth_scheme: string option; (** the authentication scheme activated *)
+ subject: Graphics_subject.t; (** the authenticated subject (user) *)
+ }
+
+ val to_string: t -> string
+ end
+
+ module Control_error : sig
+ type t = unit
+
+ val to_string: t -> string
+ end
+
+ module Block_job : sig
+ type ty = [
+ | `KnownUnknown (** explicitly named UNKNOWN in the spec *)
+ | `Pull
+ | `Copy
+ | `Commit
+ | `Unknown of int
+ ]
+
+ type status = [
+ | `Completed
+ | `Failed
+ | `Cancelled
+ | `Ready
+ | `Unknown of int
+ ]
+
+ type t = {
+ disk: string option; (** fully-qualified name of the affected disk *)
+ ty: ty; (** type of block job *)
+ status: status; (** final status of the operation *)
+ }
+
+ val to_string: t -> string
+ end
+
+ module Disk_change : sig
+ type reason = [
+ | `MissingOnStart
+ | `Unknown of int
+ ]
+
+ type t = {
+ old_src_path: string option; (** old source path *)
+ new_src_path: string option; (** new source path *)
+ dev_alias: string option; (** device alias name *)
+ reason: reason; (** reason why this callback was called *)
+ }
+
+ val to_string: t -> string
+ end
+
+ module Tray_change : sig
+ type reason = [
+ | `Open
+ | `Close
+ | `Unknown of int
+ ]
+
+ type t = {
+ dev_alias: string option; (** device alias *)
+ reason: reason; (** why the tray status was changed *)
+ }
+
+ val to_string: t -> string
+ end
+
+ module PM_wakeup : sig
+ type reason = [
+ | `Unknown of int
+ ]
+
+ type t = reason
+
+ val to_string: t -> string
+ end
+
+ module PM_suspend : sig
+ type reason = [
+ | `Unknown of int
+ ]
+
+ type t = reason
+
+ val to_string: t -> string
+ end
+
+ module Balloon_change : sig
+ type t = int64
+
+ val to_string: t -> string
+ end
+
+ module PM_suspend_disk : sig
+ type reason = [
+ | `Unknown of int
+ ]
+
+ type t = reason
+
+ val to_string: t -> string
+ end
+
+
+ type callback =
+ | Lifecycle of ([`R] Domain.t -> Lifecycle.t -> unit)
+ | Reboot of ([`R] Domain.t -> Reboot.t -> unit)
+ | RtcChange of ([`R] Domain.t -> Rtc_change.t -> unit)
+ | Watchdog of ([`R] Domain.t -> Watchdog.t -> unit)
+ | IOError of ([`R] Domain.t -> Io_error.t -> unit)
+ | Graphics of ([`R] Domain.t -> Graphics.t -> unit)
+ | IOErrorReason of ([`R] Domain.t -> Io_error.t -> unit)
+ | ControlError of ([`R] Domain.t -> Control_error.t -> unit)
+ | BlockJob of ([`R] Domain.t -> Block_job.t -> unit)
+ | DiskChange of ([`R] Domain.t -> Disk_change.t -> unit)
+ | TrayChange of ([`R] Domain.t -> Tray_change.t -> unit)
+ | PMWakeUp of ([`R] Domain.t -> PM_wakeup.t -> unit)
+ | PMSuspend of ([`R] Domain.t -> PM_suspend.t -> unit)
+ | BalloonChange of ([`R] Domain.t -> Balloon_change.t -> unit)
+ | PMSuspendDisk of ([`R] Domain.t -> PM_suspend_disk.t -> unit)
+
+ (** type of a registered call back function *)
+
+ val register_default_impl : unit -> unit
+ (** Registers the default event loop based on poll(). This
+ must be done before connections are opened.
+
+ Once registered call run_default_impl in a loop. *)
+
+ val run_default_impl : unit -> unit
+ (** Runs one iteration of the event loop. Applications will
+ generally want to have a thread which invokes this in an
+ infinite loop. *)
+
+ type callback_id
+ (** an individual event registration *)
+
+ val register_any : 'a Connect.t -> ?dom:'a Domain.t -> callback -> callback_id
+ (** [register_any con ?dom callback] registers [callback]
+ to receive notification of arbitrary domain events. Return
+ a registration id which can be used in [deregister_any].
+
+ If [?dom] is None then register for this kind of event on
+ all domains. If [dom] is [Some d] then register for this
+ kind of event only on [d].
+ *)
+
+ val deregister_any : 'a Connect.t -> callback_id -> unit
+ (** [deregister_any con id] deregisters the previously registered
+ callback with id [id]. *)
+
+ type timer_id
+ (** an individual timer event *)
+
+ val add_timeout : 'a Connect.t -> int -> (unit -> unit) -> timer_id
+ (** [add_timeout con ms cb] registers [cb] as a timeout callback
+ which will be called every [ms] milliseconds *)
+
+ val remove_timeout : 'a Connect.t -> timer_id -> unit
+ (** [remove_timeout con t] deregisters timeout callback [t]. *)
+
+end
+ (** Module dealing with events generated by domain
+ state changes. *)
+
(** {3 Networks} *)
module Network :
@@ -757,7 +1113,7 @@ sig
(** 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
+ val set_autostart : [>`W] t -> bool -> unit
(** Set the autostart flag for the storage pool. *)
val num_of_volumes : [`R] t -> int
@@ -810,9 +1166,9 @@ sig
val get_xml_desc : [`R] t -> xml
(** Get the XML description. *)
- val create_xml : [`W] Pool.t -> xml -> unit
+ val create_xml : [>`W] Pool.t -> xml -> unit
(** Create a storage volume. *)
- val delete : [`W] t -> unit
+ val delete : [>`W] t -> vol_delete_flags -> unit
(** Delete a storage volume. *)
val free : [>`R] t -> unit
(** Free a storage volume object in memory.
diff --git a/libvirt/libvirt_c.c b/libvirt/libvirt_c.c
index b1f084b..71e6f61 100644
--- a/libvirt/libvirt_c.c
+++ b/libvirt/libvirt_c.c
@@ -73,25 +73,10 @@ ocaml_libvirt_connect_close (value connv)
* In generator.pl this function has signature "conn : string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRCONNECTGETHOSTNAME
-extern char *virConnectGetHostname (virConnectPtr conn) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_get_hostname (value connv)
{
CAMLparam1 (connv);
-#ifndef HAVE_VIRCONNECTGETHOSTNAME
- /* Symbol virConnectGetHostname not found at compile time. */
- not_supported ("virConnectGetHostname");
- CAMLnoreturn;
-#else
- /* Check that the symbol virConnectGetHostname
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virConnectGetHostname);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -103,32 +88,16 @@ ocaml_libvirt_connect_get_hostname (value connv)
rv = caml_copy_string (r);
free (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virConnectGetURI.
* In generator.pl this function has signature "conn : string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRCONNECTGETURI
-extern char *virConnectGetURI (virConnectPtr conn) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_get_uri (value connv)
{
CAMLparam1 (connv);
-#ifndef HAVE_VIRCONNECTGETURI
- /* Symbol virConnectGetURI not found at compile time. */
- not_supported ("virConnectGetURI");
- CAMLnoreturn;
-#else
- /* Check that the symbol virConnectGetURI
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virConnectGetURI);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -140,7 +109,6 @@ ocaml_libvirt_connect_get_uri (value connv)
rv = caml_copy_string (r);
free (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virConnectGetType.
@@ -387,25 +355,10 @@ ocaml_libvirt_connect_list_defined_networks (value connv, value iv)
* In generator.pl this function has signature "conn : int".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS
-extern int virConnectNumOfStoragePools (virConnectPtr conn) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_num_of_storage_pools (value connv)
{
CAMLparam1 (connv);
-#ifndef HAVE_VIRCONNECTNUMOFSTORAGEPOOLS
- /* Symbol virConnectNumOfStoragePools not found at compile time. */
- not_supported ("virConnectNumOfStoragePools");
- CAMLnoreturn;
-#else
- /* Check that the symbol virConnectNumOfStoragePools
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virConnectNumOfStoragePools);
virConnectPtr conn = Connect_val (connv);
int r;
@@ -414,32 +367,16 @@ ocaml_libvirt_connect_num_of_storage_pools (value connv)
CHECK_ERROR (r == -1, conn, "virConnectNumOfStoragePools");
CAMLreturn (Val_int (r));
-#endif
}
/* Automatically generated binding for virConnectListStoragePools.
* In generator.pl this function has signature "conn, int : string array".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRCONNECTLISTSTORAGEPOOLS
-extern int virConnectListStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_list_storage_pools (value connv, value iv)
{
CAMLparam2 (connv, iv);
-#ifndef HAVE_VIRCONNECTLISTSTORAGEPOOLS
- /* Symbol virConnectListStoragePools not found at compile time. */
- not_supported ("virConnectListStoragePools");
- CAMLnoreturn;
-#else
- /* Check that the symbol virConnectListStoragePools
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virConnectListStoragePools);
CAMLlocal2 (rv, strv);
virConnectPtr conn = Connect_val (connv);
@@ -468,32 +405,16 @@ ocaml_libvirt_connect_list_storage_pools (value connv, value iv)
}
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virConnectNumOfDefinedStoragePools.
* In generator.pl this function has signature "conn : int".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS
-extern int virConnectNumOfDefinedStoragePools (virConnectPtr conn) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_num_of_defined_storage_pools (value connv)
{
CAMLparam1 (connv);
-#ifndef HAVE_VIRCONNECTNUMOFDEFINEDSTORAGEPOOLS
- /* Symbol virConnectNumOfDefinedStoragePools not found at compile time. */
- not_supported ("virConnectNumOfDefinedStoragePools");
- CAMLnoreturn;
-#else
- /* Check that the symbol virConnectNumOfDefinedStoragePools
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virConnectNumOfDefinedStoragePools);
virConnectPtr conn = Connect_val (connv);
int r;
@@ -502,32 +423,16 @@ ocaml_libvirt_connect_num_of_defined_storage_pools (value connv)
CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedStoragePools");
CAMLreturn (Val_int (r));
-#endif
}
/* Automatically generated binding for virConnectListDefinedStoragePools.
* In generator.pl this function has signature "conn, int : string array".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS
-extern int virConnectListDefinedStoragePools (virConnectPtr conn, char **const names, int maxnames) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_list_defined_storage_pools (value connv, value iv)
{
CAMLparam2 (connv, iv);
-#ifndef HAVE_VIRCONNECTLISTDEFINEDSTORAGEPOOLS
- /* Symbol virConnectListDefinedStoragePools not found at compile time. */
- not_supported ("virConnectListDefinedStoragePools");
- CAMLnoreturn;
-#else
- /* Check that the symbol virConnectListDefinedStoragePools
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virConnectListDefinedStoragePools);
CAMLlocal2 (rv, strv);
virConnectPtr conn = Connect_val (connv);
@@ -556,7 +461,6 @@ ocaml_libvirt_connect_list_defined_storage_pools (value connv, value iv)
}
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virConnectGetCapabilities.
@@ -580,6 +484,25 @@ ocaml_libvirt_connect_get_capabilities (value connv)
CAMLreturn (rv);
}
+/* Automatically generated binding for virConnectDomainEventDeregisterAny.
+ * In generator.pl this function has signature "conn, int : unit".
+ */
+
+CAMLprim value
+ocaml_libvirt_connect_domain_event_deregister_any (value connv, value iv)
+{
+ CAMLparam2 (connv, iv);
+
+ virConnectPtr conn = Connect_val (connv);
+ int i = Int_val (iv);
+ int r;
+
+ NONBLOCKING (r = virConnectDomainEventDeregisterAny (conn, i));
+ CHECK_ERROR (r == -1, conn, "virConnectDomainEventDeregisterAny");
+
+ CAMLreturn (Val_unit);
+}
+
/* Automatically generated binding for virDomainCreateLinux.
* In generator.pl this function has signature "conn, string, 0U : dom".
*/
@@ -1487,25 +1410,10 @@ ocaml_libvirt_network_set_autostart (value netv, value bv)
* In generator.pl this function has signature "pool : free".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLFREE
-extern int virStoragePoolFree (virStoragePoolPtr pool) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_free (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLFREE
- /* Symbol virStoragePoolFree not found at compile time. */
- not_supported ("virStoragePoolFree");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolFree
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolFree);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -1518,32 +1426,16 @@ ocaml_libvirt_storage_pool_free (value poolv)
Pool_val (poolv) = NULL;
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolDestroy.
* In generator.pl this function has signature "pool : free".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLDESTROY
-extern int virStoragePoolDestroy (virStoragePoolPtr pool) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_destroy (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLDESTROY
- /* Symbol virStoragePoolDestroy not found at compile time. */
- not_supported ("virStoragePoolDestroy");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolDestroy
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolDestroy);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -1556,32 +1448,16 @@ ocaml_libvirt_storage_pool_destroy (value poolv)
Pool_val (poolv) = NULL;
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolLookupByName.
* In generator.pl this function has signature "conn, string : pool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME
-extern virStoragePoolPtr virStoragePoolLookupByName (virConnectPtr conn, const char *str) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_lookup_by_name (value connv, value strv)
{
CAMLparam2 (connv, strv);
-#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYNAME
- /* Symbol virStoragePoolLookupByName not found at compile time. */
- not_supported ("virStoragePoolLookupByName");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolLookupByName
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolLookupByName);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -1594,32 +1470,16 @@ ocaml_libvirt_storage_pool_lookup_by_name (value connv, value strv)
rv = Val_pool (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolLookupByUUID.
* In generator.pl this function has signature "conn, uuid : pool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID
-extern virStoragePoolPtr virStoragePoolLookupByUUID (virConnectPtr conn, const unsigned char *str) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_lookup_by_uuid (value connv, value uuidv)
{
CAMLparam2 (connv, uuidv);
-#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUID
- /* Symbol virStoragePoolLookupByUUID not found at compile time. */
- not_supported ("virStoragePoolLookupByUUID");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolLookupByUUID
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUID);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -1632,32 +1492,16 @@ ocaml_libvirt_storage_pool_lookup_by_uuid (value connv, value uuidv)
rv = Val_pool (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolLookupByUUIDString.
* In generator.pl this function has signature "conn, string : pool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING
-extern virStoragePoolPtr virStoragePoolLookupByUUIDString (virConnectPtr conn, const char *str) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_lookup_by_uuid_string (value connv, value strv)
{
CAMLparam2 (connv, strv);
-#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYUUIDSTRING
- /* Symbol virStoragePoolLookupByUUIDString not found at compile time. */
- not_supported ("virStoragePoolLookupByUUIDString");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolLookupByUUIDString
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolLookupByUUIDString);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -1670,32 +1514,16 @@ ocaml_libvirt_storage_pool_lookup_by_uuid_string (value connv, value strv)
rv = Val_pool (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolGetName.
* In generator.pl this function has signature "pool : static string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLGETNAME
-extern const char *virStoragePoolGetName (virStoragePoolPtr pool) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_get_name (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLGETNAME
- /* Symbol virStoragePoolGetName not found at compile time. */
- not_supported ("virStoragePoolGetName");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolGetName
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolGetName);
CAMLlocal1 (rv);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -1707,32 +1535,16 @@ ocaml_libvirt_storage_pool_get_name (value poolv)
rv = caml_copy_string (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolGetXMLDesc.
* In generator.pl this function has signature "pool, 0U : string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLGETXMLDESC
-extern char *virStoragePoolGetXMLDesc (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_get_xml_desc (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLGETXMLDESC
- /* Symbol virStoragePoolGetXMLDesc not found at compile time. */
- not_supported ("virStoragePoolGetXMLDesc");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolGetXMLDesc
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolGetXMLDesc);
CAMLlocal1 (rv);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -1745,32 +1557,16 @@ ocaml_libvirt_storage_pool_get_xml_desc (value poolv)
rv = caml_copy_string (r);
free (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolGetUUID.
* In generator.pl this function has signature "pool : uuid".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLGETUUID
-extern int virStoragePoolGetUUID (virStoragePoolPtr pool, unsigned char *) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_get_uuid (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLGETUUID
- /* Symbol virStoragePoolGetUUID not found at compile time. */
- not_supported ("virStoragePoolGetUUID");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolGetUUID
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolGetUUID);
CAMLlocal1 (rv);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -1785,32 +1581,16 @@ ocaml_libvirt_storage_pool_get_uuid (value poolv)
rv = caml_alloc_string (VIR_UUID_BUFLEN);
memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolGetUUIDString.
* In generator.pl this function has signature "pool : uuid string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLGETUUIDSTRING
-extern int virStoragePoolGetUUIDString (virStoragePoolPtr pool, char *) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_get_uuid_string (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLGETUUIDSTRING
- /* Symbol virStoragePoolGetUUIDString not found at compile time. */
- not_supported ("virStoragePoolGetUUIDString");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolGetUUIDString
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolGetUUIDString);
CAMLlocal1 (rv);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -1823,32 +1603,16 @@ ocaml_libvirt_storage_pool_get_uuid_string (value poolv)
rv = caml_copy_string (uuid);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolCreateXML.
* In generator.pl this function has signature "conn, string, 0U : pool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLCREATEXML
-extern virStoragePoolPtr virStoragePoolCreateXML (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_create_xml (value connv, value strv)
{
CAMLparam2 (connv, strv);
-#ifndef HAVE_VIRSTORAGEPOOLCREATEXML
- /* Symbol virStoragePoolCreateXML not found at compile time. */
- not_supported ("virStoragePoolCreateXML");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolCreateXML
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolCreateXML);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -1861,32 +1625,16 @@ ocaml_libvirt_storage_pool_create_xml (value connv, value strv)
rv = Val_pool (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolDefineXML.
* In generator.pl this function has signature "conn, string, 0U : pool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLDEFINEXML
-extern virStoragePoolPtr virStoragePoolDefineXML (virConnectPtr conn, const char *str, unsigned int flags) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_define_xml (value connv, value strv)
{
CAMLparam2 (connv, strv);
-#ifndef HAVE_VIRSTORAGEPOOLDEFINEXML
- /* Symbol virStoragePoolDefineXML not found at compile time. */
- not_supported ("virStoragePoolDefineXML");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolDefineXML
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolDefineXML);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -1899,32 +1647,16 @@ ocaml_libvirt_storage_pool_define_xml (value connv, value strv)
rv = Val_pool (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolBuild.
* In generator.pl this function has signature "pool, uint : unit".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLBUILD
-extern int virStoragePoolBuild (virStoragePoolPtr pool, unsigned int i) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_build (value poolv, value iv)
{
CAMLparam2 (poolv, iv);
-#ifndef HAVE_VIRSTORAGEPOOLBUILD
- /* Symbol virStoragePoolBuild not found at compile time. */
- not_supported ("virStoragePoolBuild");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolBuild
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolBuild);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -1932,35 +1664,19 @@ ocaml_libvirt_storage_pool_build (value poolv, value iv)
int r;
NONBLOCKING (r = virStoragePoolBuild (pool, i));
- CHECK_ERROR (!r, conn, "virStoragePoolBuild");
+ CHECK_ERROR (r == -1, conn, "virStoragePoolBuild");
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolUndefine.
* In generator.pl this function has signature "pool : unit".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLUNDEFINE
-extern int virStoragePoolUndefine (virStoragePoolPtr pool) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_undefine (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLUNDEFINE
- /* Symbol virStoragePoolUndefine not found at compile time. */
- not_supported ("virStoragePoolUndefine");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolUndefine
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolUndefine);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -1970,32 +1686,16 @@ ocaml_libvirt_storage_pool_undefine (value poolv)
CHECK_ERROR (r == -1, conn, "virStoragePoolUndefine");
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolCreate.
* In generator.pl this function has signature "pool, 0U : unit".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLCREATE
-extern int virStoragePoolCreate (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_create (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLCREATE
- /* Symbol virStoragePoolCreate not found at compile time. */
- not_supported ("virStoragePoolCreate");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolCreate
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolCreate);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -2005,32 +1705,16 @@ ocaml_libvirt_storage_pool_create (value poolv)
CHECK_ERROR (r == -1, conn, "virStoragePoolCreate");
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolDelete.
* In generator.pl this function has signature "pool, uint : unit".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLDELETE
-extern int virStoragePoolDelete (virStoragePoolPtr pool, unsigned int i) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_delete (value poolv, value iv)
{
CAMLparam2 (poolv, iv);
-#ifndef HAVE_VIRSTORAGEPOOLDELETE
- /* Symbol virStoragePoolDelete not found at compile time. */
- not_supported ("virStoragePoolDelete");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolDelete
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolDelete);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -2038,35 +1722,19 @@ ocaml_libvirt_storage_pool_delete (value poolv, value iv)
int r;
NONBLOCKING (r = virStoragePoolDelete (pool, i));
- CHECK_ERROR (!r, conn, "virStoragePoolDelete");
+ CHECK_ERROR (r == -1, conn, "virStoragePoolDelete");
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolRefresh.
* In generator.pl this function has signature "pool, 0U : unit".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLREFRESH
-extern int virStoragePoolRefresh (virStoragePoolPtr pool, unsigned int flags) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_refresh (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLREFRESH
- /* Symbol virStoragePoolRefresh not found at compile time. */
- not_supported ("virStoragePoolRefresh");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolRefresh
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolRefresh);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -2076,32 +1744,16 @@ ocaml_libvirt_storage_pool_refresh (value poolv)
CHECK_ERROR (r == -1, conn, "virStoragePoolRefresh");
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolGetAutostart.
* In generator.pl this function has signature "pool : bool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLGETAUTOSTART
-extern int virStoragePoolGetAutostart (virStoragePoolPtr pool, int *r) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_get_autostart (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLGETAUTOSTART
- /* Symbol virStoragePoolGetAutostart not found at compile time. */
- not_supported ("virStoragePoolGetAutostart");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolGetAutostart
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolGetAutostart);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -2111,32 +1763,16 @@ ocaml_libvirt_storage_pool_get_autostart (value poolv)
CHECK_ERROR (r == -1, conn, "virStoragePoolGetAutostart");
CAMLreturn (b ? Val_true : Val_false);
-#endif
}
/* Automatically generated binding for virStoragePoolSetAutostart.
* In generator.pl this function has signature "pool, bool : unit".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLSETAUTOSTART
-extern int virStoragePoolSetAutostart (virStoragePoolPtr pool, int b) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv)
{
CAMLparam2 (poolv, bv);
-#ifndef HAVE_VIRSTORAGEPOOLSETAUTOSTART
- /* Symbol virStoragePoolSetAutostart not found at compile time. */
- not_supported ("virStoragePoolSetAutostart");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolSetAutostart
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolSetAutostart);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -2148,32 +1784,16 @@ ocaml_libvirt_storage_pool_set_autostart (value poolv, value bv)
CHECK_ERROR (r == -1, conn, "virStoragePoolSetAutostart");
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStoragePoolNumOfVolumes.
* In generator.pl this function has signature "pool : int".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES
-extern int virStoragePoolNumOfVolumes (virStoragePoolPtr pool) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_num_of_volumes (value poolv)
{
CAMLparam1 (poolv);
-#ifndef HAVE_VIRSTORAGEPOOLNUMOFVOLUMES
- /* Symbol virStoragePoolNumOfVolumes not found at compile time. */
- not_supported ("virStoragePoolNumOfVolumes");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolNumOfVolumes
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolNumOfVolumes);
virStoragePoolPtr pool = Pool_val (poolv);
virConnectPtr conn = Connect_polv (poolv);
@@ -2183,32 +1803,16 @@ ocaml_libvirt_storage_pool_num_of_volumes (value poolv)
CHECK_ERROR (r == -1, conn, "virStoragePoolNumOfVolumes");
CAMLreturn (Val_int (r));
-#endif
}
/* Automatically generated binding for virStoragePoolListVolumes.
* In generator.pl this function has signature "pool, int : string array".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLLISTVOLUMES
-extern int virStoragePoolListVolumes (virStoragePoolPtr pool, char **const names, int maxnames) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_list_volumes (value poolv, value iv)
{
CAMLparam2 (poolv, iv);
-#ifndef HAVE_VIRSTORAGEPOOLLISTVOLUMES
- /* Symbol virStoragePoolListVolumes not found at compile time. */
- not_supported ("virStoragePoolListVolumes");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolListVolumes
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolListVolumes);
CAMLlocal2 (rv, strv);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -2238,32 +1842,16 @@ ocaml_libvirt_storage_pool_list_volumes (value poolv, value iv)
}
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolFree.
* In generator.pl this function has signature "vol : free".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLFREE
-extern int virStorageVolFree (virStorageVolPtr vol) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_free (value volv)
{
CAMLparam1 (volv);
-#ifndef HAVE_VIRSTORAGEVOLFREE
- /* Symbol virStorageVolFree not found at compile time. */
- not_supported ("virStorageVolFree");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolFree
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolFree);
virStorageVolPtr vol = Volume_val (volv);
virConnectPtr conn = Connect_volv (volv);
@@ -2276,32 +1864,16 @@ ocaml_libvirt_storage_vol_free (value volv)
Volume_val (volv) = NULL;
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStorageVolDelete.
* In generator.pl this function has signature "vol, uint : unit".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLDELETE
-extern int virStorageVolDelete (virStorageVolPtr vol, unsigned int i) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_delete (value volv, value iv)
{
CAMLparam2 (volv, iv);
-#ifndef HAVE_VIRSTORAGEVOLDELETE
- /* Symbol virStorageVolDelete not found at compile time. */
- not_supported ("virStorageVolDelete");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolDelete
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolDelete);
virStorageVolPtr vol = Volume_val (volv);
virConnectPtr conn = Connect_volv (volv);
@@ -2309,35 +1881,19 @@ ocaml_libvirt_storage_vol_delete (value volv, value iv)
int r;
NONBLOCKING (r = virStorageVolDelete (vol, i));
- CHECK_ERROR (!r, conn, "virStorageVolDelete");
+ CHECK_ERROR (r == -1, conn, "virStorageVolDelete");
CAMLreturn (Val_unit);
-#endif
}
/* Automatically generated binding for virStorageVolLookupByName.
* In generator.pl this function has signature "pool, string : vol from pool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYNAME
-extern virStorageVolPtr virStorageVolLookupByName (virStoragePoolPtr pool, const char *str) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_lookup_by_name (value poolv, value strv)
{
CAMLparam2 (poolv, strv);
-#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYNAME
- /* Symbol virStorageVolLookupByName not found at compile time. */
- not_supported ("virStorageVolLookupByName");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolLookupByName
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolLookupByName);
CAMLlocal2 (rv, connv);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -2352,32 +1908,16 @@ ocaml_libvirt_storage_vol_lookup_by_name (value poolv, value strv)
rv = Val_volume (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolLookupByKey.
* In generator.pl this function has signature "conn, string : vol".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYKEY
-extern virStorageVolPtr virStorageVolLookupByKey (virConnectPtr conn, const char *str) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_lookup_by_key (value connv, value strv)
{
CAMLparam2 (connv, strv);
-#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYKEY
- /* Symbol virStorageVolLookupByKey not found at compile time. */
- not_supported ("virStorageVolLookupByKey");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolLookupByKey
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolLookupByKey);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -2390,32 +1930,16 @@ ocaml_libvirt_storage_vol_lookup_by_key (value connv, value strv)
rv = Val_volume (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolLookupByPath.
* In generator.pl this function has signature "conn, string : vol".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLLOOKUPBYPATH
-extern virStorageVolPtr virStorageVolLookupByPath (virConnectPtr conn, const char *str) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_lookup_by_path (value connv, value strv)
{
CAMLparam2 (connv, strv);
-#ifndef HAVE_VIRSTORAGEVOLLOOKUPBYPATH
- /* Symbol virStorageVolLookupByPath not found at compile time. */
- not_supported ("virStorageVolLookupByPath");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolLookupByPath
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolLookupByPath);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
@@ -2428,32 +1952,16 @@ ocaml_libvirt_storage_vol_lookup_by_path (value connv, value strv)
rv = Val_volume (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolCreateXML.
* In generator.pl this function has signature "pool, string, 0U : vol from pool".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLCREATEXML
-extern virStorageVolPtr virStorageVolCreateXML (virStoragePoolPtr pool, const char *str, unsigned int flags) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_create_xml (value poolv, value strv)
{
CAMLparam2 (poolv, strv);
-#ifndef HAVE_VIRSTORAGEVOLCREATEXML
- /* Symbol virStorageVolCreateXML not found at compile time. */
- not_supported ("virStorageVolCreateXML");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolCreateXML
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolCreateXML);
CAMLlocal2 (rv, connv);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -2468,32 +1976,16 @@ ocaml_libvirt_storage_vol_create_xml (value poolv, value strv)
rv = Val_volume (r, connv);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolGetXMLDesc.
* In generator.pl this function has signature "vol, 0U : string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLGETXMLDESC
-extern char *virStorageVolGetXMLDesc (virStorageVolPtr vol, unsigned int flags) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_get_xml_desc (value volv)
{
CAMLparam1 (volv);
-#ifndef HAVE_VIRSTORAGEVOLGETXMLDESC
- /* Symbol virStorageVolGetXMLDesc not found at compile time. */
- not_supported ("virStorageVolGetXMLDesc");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolGetXMLDesc
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolGetXMLDesc);
CAMLlocal1 (rv);
virStorageVolPtr vol = Volume_val (volv);
@@ -2506,32 +1998,16 @@ ocaml_libvirt_storage_vol_get_xml_desc (value volv)
rv = caml_copy_string (r);
free (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolGetPath.
* In generator.pl this function has signature "vol : string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLGETPATH
-extern char *virStorageVolGetPath (virStorageVolPtr vol) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_get_path (value volv)
{
CAMLparam1 (volv);
-#ifndef HAVE_VIRSTORAGEVOLGETPATH
- /* Symbol virStorageVolGetPath not found at compile time. */
- not_supported ("virStorageVolGetPath");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolGetPath
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolGetPath);
CAMLlocal1 (rv);
virStorageVolPtr vol = Volume_val (volv);
@@ -2544,32 +2020,16 @@ ocaml_libvirt_storage_vol_get_path (value volv)
rv = caml_copy_string (r);
free (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolGetKey.
* In generator.pl this function has signature "vol : static string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLGETKEY
-extern const char *virStorageVolGetKey (virStorageVolPtr vol) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_get_key (value volv)
{
CAMLparam1 (volv);
-#ifndef HAVE_VIRSTORAGEVOLGETKEY
- /* Symbol virStorageVolGetKey not found at compile time. */
- not_supported ("virStorageVolGetKey");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolGetKey
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolGetKey);
CAMLlocal1 (rv);
virStorageVolPtr vol = Volume_val (volv);
@@ -2581,32 +2041,16 @@ ocaml_libvirt_storage_vol_get_key (value volv)
rv = caml_copy_string (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStorageVolGetName.
* In generator.pl this function has signature "vol : static string".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLGETNAME
-extern const char *virStorageVolGetName (virStorageVolPtr vol) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_get_name (value volv)
{
CAMLparam1 (volv);
-#ifndef HAVE_VIRSTORAGEVOLGETNAME
- /* Symbol virStorageVolGetName not found at compile time. */
- not_supported ("virStorageVolGetName");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStorageVolGetName
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStorageVolGetName);
CAMLlocal1 (rv);
virStorageVolPtr vol = Volume_val (volv);
@@ -2618,32 +2062,16 @@ ocaml_libvirt_storage_vol_get_name (value volv)
rv = caml_copy_string (r);
CAMLreturn (rv);
-#endif
}
/* Automatically generated binding for virStoragePoolLookupByVolume.
* In generator.pl this function has signature "vol : pool from vol".
*/
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME
-extern virStoragePoolPtr virStoragePoolLookupByVolume (virStorageVolPtr vol) __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_pool_lookup_by_volume (value volv)
{
CAMLparam1 (volv);
-#ifndef HAVE_VIRSTORAGEPOOLLOOKUPBYVOLUME
- /* Symbol virStoragePoolLookupByVolume not found at compile time. */
- not_supported ("virStoragePoolLookupByVolume");
- CAMLnoreturn;
-#else
- /* Check that the symbol virStoragePoolLookupByVolume
- * is in runtime version of libvirt.
- */
- WEAK_SYMBOL_CHECK (virStoragePoolLookupByVolume);
CAMLlocal2 (rv, connv);
virStorageVolPtr vol = Volume_val (volv);
@@ -2657,7 +2085,6 @@ ocaml_libvirt_storage_pool_lookup_by_volume (value volv)
rv = Val_pool (r, connv);
CAMLreturn (rv);
-#endif
}
#include "libvirt_c_epilogue.c"
diff --git a/libvirt/libvirt_c_epilogue.c b/libvirt/libvirt_c_epilogue.c
index ac69fce..4649724 100644
--- a/libvirt/libvirt_c_epilogue.c
+++ b/libvirt/libvirt_c_epilogue.c
@@ -193,12 +193,8 @@ Val_virterror (virErrorPtr err)
static void conn_finalize (value);
static void dom_finalize (value);
static void net_finalize (value);
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static void pol_finalize (value);
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static void vol_finalize (value);
-#endif
static struct custom_operations conn_custom_operations = {
"conn_custom_operations",
@@ -228,7 +224,6 @@ static struct custom_operations net_custom_operations = {
custom_deserialize_default
};
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static struct custom_operations pol_custom_operations = {
"pol_custom_operations",
pol_finalize,
@@ -237,9 +232,7 @@ static struct custom_operations pol_custom_operations = {
custom_serialize_default,
custom_deserialize_default
};
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static struct custom_operations vol_custom_operations = {
"vol_custom_operations",
vol_finalize,
@@ -248,7 +241,6 @@ static struct custom_operations vol_custom_operations = {
custom_serialize_default,
custom_deserialize_default
};
-#endif
static value
Val_connect (virConnectPtr conn)
@@ -283,7 +275,6 @@ Val_net (virNetworkPtr net)
CAMLreturn (rv);
}
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static value
Val_pol (virStoragePoolPtr pol)
{
@@ -294,9 +285,7 @@ Val_pol (virStoragePoolPtr pol)
Pol_val (rv) = pol;
CAMLreturn (rv);
}
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static value
Val_vol (virStorageVolPtr vol)
{
@@ -307,7 +296,6 @@ Val_vol (virStorageVolPtr vol)
Vol_val (rv) = vol;
CAMLreturn (rv);
}
-#endif
/* This wraps up the (dom, conn) pair (Domain.t). */
static value
@@ -337,7 +325,6 @@ Val_network (virNetworkPtr net, value connv)
CAMLreturn (rv);
}
-#ifdef HAVE_VIRSTORAGEPOOLPTR
/* This wraps up the (pol, conn) pair (Pool.t). */
static value
Val_pool (virStoragePoolPtr pol, value connv)
@@ -351,9 +338,7 @@ Val_pool (virStoragePoolPtr pol, value connv)
Store_field (rv, 1, connv);
CAMLreturn (rv);
}
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
/* This wraps up the (vol, conn) pair (Volume.t). */
static value
Val_volume (virStorageVolPtr vol, value connv)
@@ -367,7 +352,6 @@ Val_volume (virStorageVolPtr vol, value connv)
Store_field (rv, 1, connv);
CAMLreturn (rv);
}
-#endif
static void
conn_finalize (value connv)
@@ -390,20 +374,16 @@ net_finalize (value netv)
if (net) (void) virNetworkFree (net);
}
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static void
pol_finalize (value polv)
{
virStoragePoolPtr pol = Pol_val (polv);
if (pol) (void) virStoragePoolFree (pol);
}
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static void
vol_finalize (value volv)
{
virStorageVolPtr vol = Vol_val (volv);
if (vol) (void) virStorageVolFree (vol);
}
-#endif
diff --git a/libvirt/libvirt_c_oneoffs.c b/libvirt/libvirt_c_oneoffs.c
index 3d42b73..3bb572f 100644
--- a/libvirt/libvirt_c_oneoffs.c
+++ b/libvirt/libvirt_c_oneoffs.c
@@ -129,47 +129,25 @@ ocaml_libvirt_connect_get_node_info (value connv)
CAMLreturn (rv);
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRNODEGETFREEMEMORY
-extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_node_get_free_memory (value connv)
{
-#ifdef HAVE_VIRNODEGETFREEMEMORY
CAMLparam1 (connv);
CAMLlocal1 (rv);
virConnectPtr conn = Connect_val (connv);
unsigned long long r;
- WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
NONBLOCKING (r = virNodeGetFreeMemory (conn));
CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
rv = caml_copy_int64 ((int64) r);
CAMLreturn (rv);
-#else
- not_supported ("virNodeGetFreeMemory");
-#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
-extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
- unsigned long long *freeMems,
- int startCell, int maxCells)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
value startv, value maxv)
{
-#ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
CAMLparam3 (connv, startv, maxv);
CAMLlocal2 (rv, iv);
virConnectPtr conn = Connect_val (connv);
@@ -178,7 +156,6 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
int r, i;
unsigned long long freemems[max];
- WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
@@ -189,12 +166,26 @@ ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
}
CAMLreturn (rv);
-#else
- not_supported ("virNodeGetCellsFreeMemory");
-#endif
}
CAMLprim value
+ocaml_libvirt_connect_set_keep_alive(value connv,
+ value intervalv, value countv)
+{
+ CAMLparam3 (connv, intervalv, countv);
+ virConnectPtr conn = Connect_val(connv);
+ int interval = Int_val(intervalv);
+ unsigned int count = Int_val(countv);
+ int r;
+
+ NONBLOCKING(r = virConnectSetKeepAlive(conn, interval, count));
+ CHECK_ERROR (r == -1, conn, "virConnectSetKeepAlive");
+
+ CAMLreturn(Val_unit);
+}
+
+
+CAMLprim value
ocaml_libvirt_domain_get_id (value domv)
{
CAMLparam1 (domv);
@@ -280,18 +271,9 @@ ocaml_libvirt_domain_get_info (value domv)
CAMLreturn (rv);
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
-extern char *virDomainGetSchedulerType(virDomainPtr domain,
- int *nparams)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_get_scheduler_type (value domv)
{
-#ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
CAMLparam1 (domv);
CAMLlocal2 (rv, strv);
virDomainPtr dom = Domain_val (domv);
@@ -299,7 +281,6 @@ ocaml_libvirt_domain_get_scheduler_type (value domv)
char *r;
int nparams;
- WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
@@ -308,24 +289,11 @@ ocaml_libvirt_domain_get_scheduler_type (value domv)
free (r);
Store_field (rv, 1, nparams);
CAMLreturn (rv);
-#else
- not_supported ("virDomainGetSchedulerType");
-#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
-extern int virDomainGetSchedulerParameters (virDomainPtr domain,
- virSchedParameterPtr params,
- int *nparams)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
{
-#ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
CAMLparam2 (domv, nparamsv);
CAMLlocal4 (rv, v, v2, v3);
virDomainPtr dom = Domain_val (domv);
@@ -334,7 +302,6 @@ ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
virSchedParameter params[nparams];
int r, i;
- WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
@@ -373,24 +340,11 @@ ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
Store_field (v, 1, v2);
}
CAMLreturn (rv);
-#else
- not_supported ("virDomainGetSchedulerParameters");
-#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
-extern int virDomainSetSchedulerParameters (virDomainPtr domain,
- virSchedParameterPtr params,
- int nparams)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
{
-#ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
CAMLparam2 (domv, paramsv);
CAMLlocal1 (v);
virDomainPtr dom = Domain_val (domv);
@@ -436,14 +390,10 @@ ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
}
}
- WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
CAMLreturn (Val_unit);
-#else
- not_supported ("virDomainSetSchedulerParameters");
-#endif
}
CAMLprim value
@@ -519,30 +469,21 @@ ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
CAMLreturn (rv);
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINGETCPUSTATS
-extern int virDomainGetCPUStats (virDomainPtr domain,
- virTypedParameterPtr params,
- unsigned int nparams,
- int start_cpu,
- unsigned int ncpus,
- unsigned int flags)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
-ocaml_libvirt_domain_get_cpu_stats (value domv, value nr_pcpusv)
+ocaml_libvirt_domain_get_cpu_stats (value domv)
{
-#ifdef HAVE_VIRDOMAINGETCPUSTATS
- CAMLparam2 (domv, nr_pcpusv);
+ CAMLparam1 (domv);
CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
CAMLlocal1 (v);
virDomainPtr dom = Domain_val (domv);
virConnectPtr conn = Connect_domv (domv);
- int nr_pcpus = Int_val (nr_pcpusv);
virTypedParameterPtr params;
int r, cpu, ncpus, nparams, i, j, pos;
+ int nr_pcpus;
+
+ /* get number of pcpus */
+ NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
+ CHECK_ERROR (nr_pcpus < 0, conn, "virDomainGetCPUStats");
/* get percpu information */
NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
@@ -629,24 +570,11 @@ ocaml_libvirt_domain_get_cpu_stats (value domv, value nr_pcpusv)
}
free(params);
CAMLreturn (cpustats);
-#else
- not_supported ("virDomainGetCPUStats");
-#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINMIGRATE
-extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
- unsigned long flags, const char *dname,
- const char *uri, unsigned long bandwidth)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
{
-#ifdef HAVE_VIRDOMAINMIGRATE
CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
CAMLxparam2 (optbandwidthv, unitv);
CAMLlocal2 (flagv, rv);
@@ -672,17 +600,12 @@ ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, val
else /* Some bandwidth */
bandwidth = Int_val (Field (optbandwidthv, 0));
- WEAK_SYMBOL_CHECK (virDomainMigrate);
NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
CHECK_ERROR (!r, conn, "virDomainMigrate");
rv = Val_domain (r, dconnv);
CAMLreturn (rv);
-
-#else /* virDomainMigrate not supported */
- not_supported ("virDomainMigrate");
-#endif
}
CAMLprim value
@@ -693,20 +616,9 @@ ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
argv[6]);
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINBLOCKSTATS
-extern int virDomainBlockStats (virDomainPtr dom,
- const char *path,
- virDomainBlockStatsPtr stats,
- size_t size)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_block_stats (value domv, value pathv)
{
-#if HAVE_VIRDOMAINBLOCKSTATS
CAMLparam2 (domv, pathv);
CAMLlocal2 (rv,v);
virDomainPtr dom = Domain_val (domv);
@@ -715,7 +627,6 @@ ocaml_libvirt_domain_block_stats (value domv, value pathv)
struct _virDomainBlockStats stats;
int r;
- WEAK_SYMBOL_CHECK (virDomainBlockStats);
NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
@@ -727,25 +638,11 @@ ocaml_libvirt_domain_block_stats (value domv, value pathv)
v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
CAMLreturn (rv);
-#else
- not_supported ("virDomainBlockStats");
-#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAININTERFACESTATS
-extern int virDomainInterfaceStats (virDomainPtr dom,
- const char *path,
- virDomainInterfaceStatsPtr stats,
- size_t size)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_interface_stats (value domv, value pathv)
{
-#if HAVE_VIRDOMAININTERFACESTATS
CAMLparam2 (domv, pathv);
CAMLlocal2 (rv,v);
virDomainPtr dom = Domain_val (domv);
@@ -754,7 +651,6 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv)
struct _virDomainInterfaceStats stats;
int r;
- WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
@@ -769,27 +665,11 @@ ocaml_libvirt_domain_interface_stats (value domv, value pathv)
v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
CAMLreturn (rv);
-#else
- not_supported ("virDomainInterfaceStats");
-#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINBLOCKPEEK
-extern int virDomainBlockPeek (virDomainPtr domain,
- const char *path,
- unsigned long long offset,
- size_t size,
- void *buffer,
- unsigned int flags)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
{
-#ifdef HAVE_VIRDOMAINBLOCKPEEK
CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
CAMLxparam1 (boffv);
virDomainPtr dom = Domain_val (domv);
@@ -805,16 +685,11 @@ ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv,
if (caml_string_length (bufferv) < boff + size)
caml_failwith ("virDomainBlockPeek: return buffer too short");
- WEAK_SYMBOL_CHECK (virDomainBlockPeek);
/* NB. not NONBLOCKING because buffer might move (XXX) */
r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
CAMLreturn (Val_unit);
-
-#else /* virDomainBlockPeek not supported */
- not_supported ("virDomainBlockPeek");
-#endif
}
CAMLprim value
@@ -824,21 +699,9 @@ ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
argv[3], argv[4], argv[5]);
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRDOMAINMEMORYPEEK
-extern int virDomainMemoryPeek (virDomainPtr domain,
- unsigned long long start,
- size_t size,
- void *buffer,
- unsigned int flags)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
{
-#ifdef HAVE_VIRDOMAINMEMORYPEEK
CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
CAMLxparam1 (boffv);
CAMLlocal1 (flagv);
@@ -863,16 +726,11 @@ ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv
flags |= VIR_MEMORY_VIRTUAL;
}
- WEAK_SYMBOL_CHECK (virDomainMemoryPeek);
/* NB. not NONBLOCKING because buffer might move (XXX) */
r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
CAMLreturn (Val_unit);
-
-#else /* virDomainMemoryPeek not supported */
- not_supported ("virDomainMemoryPeek");
-#endif
}
CAMLprim value
@@ -882,17 +740,420 @@ ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
argv[3], argv[4], argv[5]);
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEPOOLGETINFO
-extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info)
- __attribute__((weak));
-#endif
-#endif
+/*----------------------------------------------------------------------*/
+
+/* Domain events */
+
+CAMLprim value
+ocaml_libvirt_event_register_default_impl (value unitv)
+{
+ CAMLparam1 (unitv);
+
+ /* arg is of type unit = void */
+ int r;
+
+ NONBLOCKING (r = virEventRegisterDefaultImpl ());
+ /* must be called before connection, therefore we can't use CHECK_ERROR */
+ if (r == -1) caml_failwith("virEventRegisterDefaultImpl");
+
+ CAMLreturn (Val_unit);
+}
+
+CAMLprim value
+ocaml_libvirt_event_run_default_impl (value unitv)
+{
+ CAMLparam1 (unitv);
+
+ /* arg is of type unit = void */
+ int r;
+
+ NONBLOCKING (r = virEventRunDefaultImpl ());
+ if (r == -1) caml_failwith("virEventRunDefaultImpl");
+
+ CAMLreturn (Val_unit);
+}
+
+/* We register a single C callback function for every distinct
+ callback signature. We encode the signature itself in the function
+ name and also in the name of the assocated OCaml callback
+ e.g.:
+ a C function called
+ i_i64_s_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ int x,
+ long y,
+ char *z,
+ void *opaque)
+ would correspond to an OCaml callback
+ Libvirt.i_i64_s_callback :
+ int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit
+ where the initial int64 is a unique ID used by the OCaml to
+ dispatch to the specific OCaml closure and stored by libvirt
+ as the "opaque" data. */
+
+/* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME)
+ where NAME is the string name of the OCaml callback registered
+ in libvirt.ml. */
+#define DOMAIN_CALLBACK_BEGIN(NAME) \
+ value connv, domv, callback_id, result; \
+ connv = domv = callback_id = result = Val_int(0); \
+ static value *callback = NULL; \
+ caml_leave_blocking_section(); \
+ if (callback == NULL) \
+ callback = caml_named_value(NAME); \
+ if (callback == NULL) \
+ abort(); /* C code out of sync with OCaml code */ \
+ if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1)) \
+ abort(); /* should never happen in practice? */ \
+ \
+ Begin_roots4(connv, domv, callback_id, result); \
+ connv = Val_connect(conn); \
+ domv = Val_domain(dom, connv); \
+ callback_id = caml_copy_int64(*(long *)opaque);
+
+/* Every one of the callbacks ends with a CALLBACK_END */
+#define DOMAIN_CALLBACK_END \
+ (void) caml_callback3(*callback, callback_id, domv, result); \
+ End_roots(); \
+ caml_enter_blocking_section();
+
+
+static void
+i_i_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ int x,
+ int y,
+ void * opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback")
+ result = caml_alloc_tuple(2);
+ Store_field(result, 0, Val_int(x));
+ Store_field(result, 1, Val_int(y));
+ DOMAIN_CALLBACK_END
+}
+
+static void
+u_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ void *opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback")
+ result = Val_int(0); /* () */
+ DOMAIN_CALLBACK_END
+}
+
+static void
+i64_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ long long int64,
+ void *opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback")
+ result = caml_copy_int64(int64);
+ DOMAIN_CALLBACK_END
+}
+
+static void
+i_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ int x,
+ void *opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback")
+ result = Val_int(x);
+ DOMAIN_CALLBACK_END
+}
+
+static void
+s_i_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ char *x,
+ int y,
+ void * opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback")
+ result = caml_alloc_tuple(2);
+ Store_field(result, 0,
+ Val_opt(x, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 1, Val_int(y));
+ DOMAIN_CALLBACK_END
+}
+
+static void
+s_i_i_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ char *x,
+ int y,
+ int z,
+ void * opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback")
+ result = caml_alloc_tuple(3);
+ Store_field(result, 0,
+ Val_opt(x, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 1, Val_int(y));
+ Store_field(result, 2, Val_int(z));
+ DOMAIN_CALLBACK_END
+}
+
+static void
+s_s_i_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ char *x,
+ char *y,
+ int z,
+ void *opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback")
+ result = caml_alloc_tuple(3);
+ Store_field(result, 0,
+ Val_opt(x, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 1,
+ Val_opt(y, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 2, Val_int(z));
+ DOMAIN_CALLBACK_END
+}
+
+static void
+s_s_i_s_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ char *x,
+ char *y,
+ int z,
+ char *a,
+ void *opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback")
+ result = caml_alloc_tuple(4);
+ Store_field(result, 0,
+ Val_opt(x, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 1,
+ Val_opt(y, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 2, Val_int(z));
+ Store_field(result, 3,
+ Val_opt(a, (Val_ptr_t) caml_copy_string));
+ DOMAIN_CALLBACK_END
+}
+
+static void
+s_s_s_i_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ char * x,
+ char * y,
+ char * z,
+ int a,
+ void * opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback")
+ result = caml_alloc_tuple(4);
+ Store_field(result, 0,
+ Val_opt(x, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 1,
+ Val_opt(y, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 2,
+ Val_opt(z, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 3, Val_int(a));
+ DOMAIN_CALLBACK_END
+}
+
+static value
+Val_event_graphics_address(virDomainEventGraphicsAddressPtr x)
+{
+ CAMLparam0 ();
+ CAMLlocal1(result);
+ result = caml_alloc_tuple(3);
+ Store_field(result, 0, Val_int(x->family));
+ Store_field(result, 1,
+ Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 2,
+ Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string));
+ CAMLreturn(result);
+}
+
+static value
+Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x)
+{
+ CAMLparam0 ();
+ CAMLlocal1(result);
+ result = caml_alloc_tuple(2);
+ Store_field(result, 0,
+ Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 1,
+ Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string));
+ CAMLreturn(result);
+
+}
+
+static value
+Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x)
+{
+ CAMLparam0 ();
+ CAMLlocal1(result);
+ int i;
+ result = caml_alloc_tuple(x->nidentity);
+ for (i = 0; i < x->nidentity; i++ )
+ Store_field(result, i,
+ Val_event_graphics_subject_identity(x->identities + i));
+ CAMLreturn(result);
+}
+
+static void
+i_ga_ga_s_gs_callback(virConnectPtr conn,
+ virDomainPtr dom,
+ int i1,
+ virDomainEventGraphicsAddressPtr ga1,
+ virDomainEventGraphicsAddressPtr ga2,
+ char *s1,
+ virDomainEventGraphicsSubjectPtr gs1,
+ void * opaque)
+{
+ DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback")
+ result = caml_alloc_tuple(5);
+ Store_field(result, 0, Val_int(i1));
+ Store_field(result, 1, Val_event_graphics_address(ga1));
+ Store_field(result, 2, Val_event_graphics_address(ga2));
+ Store_field(result, 3,
+ Val_opt(s1, (Val_ptr_t) caml_copy_string));
+ Store_field(result, 4, Val_event_graphics_subject(gs1));
+ DOMAIN_CALLBACK_END
+}
+
+static void
+timeout_callback(int timer, void *opaque)
+{
+ value callback_id, result;
+ callback_id = result = Val_int(0);
+ static value *callback = NULL;
+ caml_leave_blocking_section();
+ if (callback == NULL)
+ callback = caml_named_value("Libvirt.timeout_callback");
+ if (callback == NULL)
+ abort(); /* C code out of sync with OCaml code */
+
+ Begin_roots2(callback_id, result);
+ callback_id = caml_copy_int64(*(long *)opaque);
+
+ (void)caml_callback_exn(*callback, callback_id);
+ End_roots();
+ caml_enter_blocking_section();
+}
+
+CAMLprim value
+ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id)
+{
+ CAMLparam3 (connv, ms, callback_id);
+ virConnectPtr conn = Connect_val (connv);
+ void *opaque;
+ virFreeCallback freecb = free;
+ virEventTimeoutCallback cb = timeout_callback;
+
+ int r;
+
+ /* Store the int64 callback_id as the opaque data so the OCaml
+ callback can demultiplex to the correct OCaml handler. */
+ if ((opaque = malloc(sizeof(long))) == NULL)
+ caml_failwith ("virEventAddTimeout: malloc");
+ *((long*)opaque) = Int64_val(callback_id);
+ NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb));
+ CHECK_ERROR(r == -1, conn, "virEventAddTimeout");
+
+ CAMLreturn(Val_int(r));
+}
+
+CAMLprim value
+ocaml_libvirt_event_remove_timeout (value connv, value timer_id)
+{
+ CAMLparam2 (connv, timer_id);
+ virConnectPtr conn = Connect_val (connv);
+ int r;
+
+ NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id)));
+ CHECK_ERROR(r == -1, conn, "virEventRemoveTimeout");
+
+ CAMLreturn(Val_int(r));
+}
+
+CAMLprim value
+ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id)
+{
+ CAMLparam4(connv, domv, callback, callback_id);
+
+ virConnectPtr conn = Connect_val (connv);
+ virDomainPtr dom = NULL;
+ int eventID = Tag_val(callback);
+
+ virConnectDomainEventGenericCallback cb;
+ void *opaque;
+ virFreeCallback freecb = free;
+ int r;
+
+ if (domv != Val_int(0))
+ dom = Domain_val (Field(domv, 0));
+
+ switch (eventID){
+ case VIR_DOMAIN_EVENT_ID_LIFECYCLE:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_REBOOT:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_RTC_CHANGE:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_WATCHDOG:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_IO_ERROR:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_GRAPHICS:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_BLOCK_JOB:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_DISK_CHANGE:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_PMWAKEUP:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_PMSUSPEND:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
+ break;
+ case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK:
+ cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
+ break;
+ default:
+ caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID");
+ }
+
+ /* Store the int64 callback_id as the opaque data so the OCaml
+ callback can demultiplex to the correct OCaml handler. */
+ if ((opaque = malloc(sizeof(long))) == NULL)
+ caml_failwith ("virConnectDomainEventRegisterAny: malloc");
+ *((long*)opaque) = Int64_val(callback_id);
+ NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb));
+ CHECK_ERROR(r == -1, conn, "virConnectDomainEventRegisterAny");
+
+ CAMLreturn(Val_int(r));
+}
CAMLprim value
ocaml_libvirt_storage_pool_get_info (value poolv)
{
-#if HAVE_VIRSTORAGEPOOLGETINFO
CAMLparam1 (poolv);
CAMLlocal2 (rv, v);
virStoragePoolPtr pool = Pool_val (poolv);
@@ -900,7 +1161,6 @@ ocaml_libvirt_storage_pool_get_info (value poolv)
virStoragePoolInfo info;
int r;
- WEAK_SYMBOL_CHECK (virStoragePoolGetInfo);
NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo");
@@ -911,22 +1171,11 @@ ocaml_libvirt_storage_pool_get_info (value poolv)
v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
CAMLreturn (rv);
-#else
- not_supported ("virStoragePoolGetInfo");
-#endif
}
-#ifdef HAVE_WEAK_SYMBOLS
-#ifdef HAVE_VIRSTORAGEVOLGETINFO
-extern int virStorageVolGetInfo(virStorageVolPtr vol, virStorageVolInfoPtr info)
- __attribute__((weak));
-#endif
-#endif
-
CAMLprim value
ocaml_libvirt_storage_vol_get_info (value volv)
{
-#if HAVE_VIRSTORAGEVOLGETINFO
CAMLparam1 (volv);
CAMLlocal2 (rv, v);
virStorageVolPtr vol = Volume_val (volv);
@@ -934,19 +1183,15 @@ ocaml_libvirt_storage_vol_get_info (value volv)
virStorageVolInfo info;
int r;
- WEAK_SYMBOL_CHECK (virStorageVolGetInfo);
NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo");
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);
+ v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
CAMLreturn (rv);
-#else
- not_supported ("virStorageVolGetInfo");
-#endif
}
/*----------------------------------------------------------------------*/
diff --git a/libvirt/libvirt_c_prologue.c b/libvirt/libvirt_c_prologue.c
index 2050078..7d9c0f5 100644
--- a/libvirt/libvirt_c_prologue.c
+++ b/libvirt/libvirt_c_prologue.c
@@ -46,28 +46,6 @@ static value Val_virterror (virErrorPtr err);
#define CHECK_ERROR(cond, conn, fn) \
do { if (cond) _raise_virterror (conn, fn); } while (0)
-/* For more about weak symbols, see:
- * http://kolpackov.net/pipermail/notes/2004-March/000006.html
- * We are using this to do runtime detection of library functions
- * so that if we dynamically link with an older version of
- * libvirt than we were compiled against, it won't fail (provided
- * libvirt >= 0.2.1 - we don't support anything older).
- */
-#ifdef __GNUC__
-#ifdef linux
-#if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3)
-#define HAVE_WEAK_SYMBOLS 1
-#endif
-#endif
-#endif
-
-#ifdef HAVE_WEAK_SYMBOLS
-#define WEAK_SYMBOL_CHECK(sym) \
- do { if (!sym) not_supported(#sym); } while (0)
-#else
-#define WEAK_SYMBOL_CHECK(sym)
-#endif /* HAVE_WEAK_SYMBOLS */
-
/*----------------------------------------------------------------------*/
/* Some notes about the use of custom blocks to store virConnectPtr,
@@ -113,49 +91,29 @@ static value Val_virterror (virErrorPtr err);
#define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
#define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
#define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
-#ifdef HAVE_VIRSTORAGEPOOLPTR
#define Pol_val(rv) (*((virStoragePoolPtr *)Data_custom_val(rv)))
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
#define Vol_val(rv) (*((virStorageVolPtr *)Data_custom_val(rv)))
-#endif
/* Wrap up a pointer to something in a custom block. */
static value Val_connect (virConnectPtr conn);
static value Val_dom (virDomainPtr dom);
static value Val_net (virNetworkPtr net);
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static value Val_pol (virStoragePoolPtr pool);
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static value Val_vol (virStorageVolPtr vol);
-#endif
/* Domains and networks are stored as pairs (dom/net, conn), so have
* some convenience functions for unwrapping and wrapping them.
*/
#define Domain_val(rv) (Dom_val(Field((rv),0)))
#define Network_val(rv) (Net_val(Field((rv),0)))
-#ifdef HAVE_VIRSTORAGEPOOLPTR
#define Pool_val(rv) (Pol_val(Field((rv),0)))
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
#define Volume_val(rv) (Vol_val(Field((rv),0)))
-#endif
#define Connect_domv(rv) (Connect_val(Field((rv),1)))
#define Connect_netv(rv) (Connect_val(Field((rv),1)))
-#ifdef HAVE_VIRSTORAGEPOOLPTR
#define Connect_polv(rv) (Connect_val(Field((rv),1)))
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
#define Connect_volv(rv) (Connect_val(Field((rv),1)))
-#endif
static value Val_domain (virDomainPtr dom, value connv);
static value Val_network (virNetworkPtr net, value connv);
-#ifdef HAVE_VIRSTORAGEPOOLPTR
static value Val_pool (virStoragePoolPtr pol, value connv);
-#endif
-#ifdef HAVE_VIRSTORAGEVOLPTR
static value Val_volume (virStorageVolPtr vol, value connv);
-#endif
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-11 12:47:14 +0000