libvirt/libvirt_c.c

   1 /* OCaml bindings for libvirt.
   2  * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3  * http://libvirt.org/
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public
   7  * License as published by the Free Software Foundation; either
   8  * version 2 of the License, or (at your option) any later version.
   9  *
  10  * This library is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  18  */
  19
  20 #include "config.h"
  21
  22 #include <stdio.h>
  23 #include <stdlib.h>
  24 #include <string.h>
  25
  26 #include <libvirt/libvirt.h>
  27 #include <libvirt/virterror.h>
  28
  29 #include <caml/config.h>
  30 #include <caml/alloc.h>
  31 #include <caml/callback.h>
  32 #include <caml/custom.h>
  33 #include <caml/fail.h>
  34 #include <caml/memory.h>
  35 #include <caml/misc.h>
  36 #include <caml/mlvalues.h>
  37 #include <caml/signals.h>
  38
  39 static char *Optstring_val (value strv);
  40 typedef value (*Val_ptr_t) (void *);
  41 static value Val_opt (void *ptr, Val_ptr_t Val_ptr);
  42 /*static value option_default (value option, value deflt);*/
  43 static value _raise_virterror (virConnectPtr conn, const char *fn);
  44 static value Val_virterror (virErrorPtr err);
  45
  46 /* Use this around synchronous libvirt API calls to release the OCaml
  47  * lock, allowing other threads to run simultaneously.  'code' must not
  48  * perform any caml_* calls, run any OCaml code, or raise any exception.
  49  * http://web.archive.org/web/20030521020915/http://caml.inria.fr/archives/200106/msg00199.html
  50  */
  51 #define NONBLOCKING(code)                       \
  52   do {                                          \
  53     caml_enter_blocking_section ();             \
  54     code;                                       \
  55     caml_leave_blocking_section ();             \
  56   } while (0)
  57
  58 /* Check error condition from a libvirt function, and automatically raise
  59  * an exception if one is found.
  60  */
  61 #define CHECK_ERROR(cond, conn, fn) \
  62   do { if (cond) _raise_virterror (conn, fn); } while (0)
  63
  64 #define NOT_SUPPORTED(fn)                       \
  65   caml_invalid_argument (fn " not supported")
  66
  67 /* For more about weak symbols, see:
  68  * http://kolpackov.net/pipermail/notes/2004-March/000006.html
  69  * We are using this to do runtime detection of library functions
  70  * so that if we dynamically link with an older version of
  71  * libvirt than we were compiled against, it won't fail (provided
  72  * libvirt >= 0.2.1 - we don't support anything older).
  73  */
  74 #ifdef __GNUC__
  75 #ifdef linux
  76 #if (__GNUC__ == 3 && __GNUC_MINOR__ >= 3) || (__GNUC__ > 3)
  77 #define HAVE_WEAK_SYMBOLS 1
  78 #endif
  79 #endif
  80 #endif
  81
  82 #ifdef HAVE_WEAK_SYMBOLS
  83 #define WEAK_SYMBOL_CHECK(sym)                          \
  84   do { if (!sym) NOT_SUPPORTED(#sym); } while (0)
  85 #else
  86 #define WEAK_SYMBOL_CHECK(sym)
  87 #endif /* HAVE_WEAK_SYMBOLS */
  88
  89 #ifdef HAVE_WEAK_SYMBOLS
  90 #ifdef HAVE_VIRCONNECTGETHOSTNAME
  91 extern char *virConnectGetHostname (virConnectPtr conn)
  92   __attribute__((weak));
  93 #endif
  94 #ifdef HAVE_VIRCONNECTGETURI
  95 extern char *virConnectGetURI (virConnectPtr conn)
  96   __attribute__((weak));
  97 #endif
  98 #ifdef HAVE_VIRDOMAINBLOCKSTATS
  99 extern int virDomainBlockStats (virDomainPtr dom,
 100                                 const char *path,
 101                                 virDomainBlockStatsPtr stats,
 102                                 size_t size)
 103   __attribute__((weak));
 104 #endif
 105 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 106 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
 107                                             virSchedParameterPtr params,
 108                                             int *nparams)
 109   __attribute__((weak));
 110 #endif
 111 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 112 extern char *virDomainGetSchedulerType(virDomainPtr domain,
 113                                        int *nparams)
 114   __attribute__((weak));
 115 #endif
 116 #ifdef HAVE_VIRDOMAININTERFACESTATS
 117 extern int virDomainInterfaceStats (virDomainPtr dom,
 118                                     const char *path,
 119                                     virDomainInterfaceStatsPtr stats,
 120                                     size_t size)
 121   __attribute__((weak));
 122 #endif
 123 #ifdef HAVE_VIRDOMAINMIGRATE
 124 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
 125                                       unsigned long flags, const char *dname,
 126                                       const char *uri, unsigned long bandwidth)
 127   __attribute__((weak));
 128 #endif
 129 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 130 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
 131                                             virSchedParameterPtr params,
 132                                             int nparams)
 133   __attribute__((weak));
 134 #endif
 135 #ifdef HAVE_VIRNODEGETFREEMEMORY
 136 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
 137   __attribute__((weak));
 138 #endif
 139 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
 140 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
 141                                       unsigned long long *freeMems,
 142                                       int startCell, int maxCells)
 143   __attribute__((weak));
 144 #endif
 145 #endif /* HAVE_WEAK_SYMBOLS */
 146
 147 /*----------------------------------------------------------------------*/
 148
 149 CAMLprim value
 150 ocaml_libvirt_get_version (value driverv, value unit)
 151 {
 152   CAMLparam2 (driverv, unit);
 153   CAMLlocal1 (rv);
 154   const char *driver = Optstring_val (driverv);
 155   unsigned long libVer, typeVer = 0, *typeVer_ptr;
 156   int r;
 157
 158   typeVer_ptr = driver ? &typeVer : NULL;
 159   NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
 160   CHECK_ERROR (r == -1, NULL, "virGetVersion");
 161
 162   rv = caml_alloc_tuple (2);
 163   Store_field (rv, 0, Val_int (libVer));
 164   Store_field (rv, 1, Val_int (typeVer));
 165   CAMLreturn (rv);
 166 }
 167
 168 /*----------------------------------------------------------------------*/
 169
 170 /* Some notes about the use of custom blocks to store virConnectPtr,
 171  * virDomainPtr and virNetworkPtr.
 172  *------------------------------------------------------------------
 173  *
 174  * Libvirt does some tricky reference counting to keep track of
 175  * virConnectPtr's, virDomainPtr's and virNetworkPtr's.
 176  *
 177  * There is only one function which can return a virConnectPtr
 178  * (virConnectOpen*) and that allocates a new one each time.
 179  *
 180  * virDomainPtr/virNetworkPtr's on the other hand can be returned
 181  * repeatedly (for the same underlying domain/network), and we must
 182  * keep track of each one and explicitly free it with virDomainFree
 183  * or virNetworkFree.  If we lose track of one then the reference
 184  * counting in libvirt will keep it open.  We therefore wrap these
 185  * in a custom block with a finalizer function.
 186  *
 187  * We also have to allow the user to explicitly free them, in
 188  * which case we set the pointer inside the custom block to NULL.
 189  * The finalizer notices this and doesn't free the object.
 190  *
 191  * Domains and networks "belong to" a connection.  We have to avoid
 192  * the situation like this:
 193  *
 194  *   let conn = Connect.open ... in
 195  *   let dom = Domain.lookup_by_id conn 0 in
 196  *   (* conn goes out of scope and is garbage collected *)
 197  *   printf "dom name = %s\n" (Domain.get_name dom)
 198  *
 199  * The reason is that when conn is garbage collected, virConnectClose
 200  * is called and any subsequent operations on dom will fail (in fact
 201  * will probably segfault).  To stop this from happening, the OCaml
 202  * wrappers store domains (and networks) as explicit (dom, conn)
 203  * pairs.
 204  *
 205  * Further complication with virterror / exceptions: Virterror gives
 206  * us virConnectPtr, virDomainPtr, virNetworkPtr pointers.  If we
 207  * follow standard practice and wrap these up in blocks with
 208  * finalizers then we'll end up double-freeing (in particular, calling
 209  * virConnectClose at the wrong time).  So for virterror, we have
 210  * "special" wrapper functions (Val_connect_no_finalize, etc.).
 211  */
 212
 213 /* Unwrap a custom block. */
 214 #define Connect_val(rv) (*((virConnectPtr *)Data_custom_val(rv)))
 215 #define Dom_val(rv) (*((virDomainPtr *)Data_custom_val(rv)))
 216 #define Net_val(rv) (*((virNetworkPtr *)Data_custom_val(rv)))
 217
 218 /* Wrap up a pointer to something in a custom block. */
 219 static value Val_connect (virConnectPtr conn);
 220 static value Val_dom (virDomainPtr dom);
 221 static value Val_net (virNetworkPtr net);
 222
 223 /* ONLY for use by virterror wrappers. */
 224 static value Val_connect_no_finalize (virConnectPtr conn);
 225 static value Val_dom_no_finalize (virDomainPtr dom);
 226 static value Val_net_no_finalize (virNetworkPtr net);
 227
 228 /* Domains and networks are stored as pairs (dom/net, conn), so have
 229  * some convenience functions for unwrapping and wrapping them.
 230  */
 231 #define Domain_val(rv) (Dom_val(Field((rv),0)))
 232 #define Network_val(rv) (Net_val(Field((rv),0)))
 233 #define Connect_domv(rv) (Connect_val(Field((rv),1)))
 234 #define Connect_netv(rv) (Connect_val(Field((rv),1)))
 235
 236 static value Val_domain (virDomainPtr dom, value connv);
 237 static value Val_network (virNetworkPtr net, value connv);
 238
 239 /* ONLY for use by virterror wrappers. */
 240 static value Val_domain_no_finalize (virDomainPtr dom, value connv);
 241 static value Val_network_no_finalize (virNetworkPtr net, value connv);
 242
 243 /*----------------------------------------------------------------------*/
 244
 245 /* Connection object. */
 246
 247 CAMLprim value
 248 ocaml_libvirt_connect_open (value namev, value unit)
 249 {
 250   CAMLparam2 (namev, unit);
 251   CAMLlocal1 (rv);
 252   const char *name = Optstring_val (namev);
 253   virConnectPtr conn;
 254
 255   NONBLOCKING (conn = virConnectOpen (name));
 256   CHECK_ERROR (!conn, NULL, "virConnectOpen");
 257
 258   rv = Val_connect (conn);
 259
 260   CAMLreturn (rv);
 261 }
 262
 263 CAMLprim value
 264 ocaml_libvirt_connect_open_readonly (value namev, value unit)
 265 {
 266   CAMLparam2 (namev, unit);
 267   CAMLlocal1 (rv);
 268   const char *name = Optstring_val (namev);
 269   virConnectPtr conn;
 270
 271   NONBLOCKING (conn = virConnectOpenReadOnly (name));
 272   CHECK_ERROR (!conn, NULL, "virConnectOpen");
 273
 274   rv = Val_connect (conn);
 275
 276   CAMLreturn (rv);
 277 }
 278
 279 CAMLprim value
 280 ocaml_libvirt_connect_close (value connv)
 281 {
 282   CAMLparam1 (connv);
 283   virConnectPtr conn = Connect_val (connv);
 284   int r;
 285
 286   NONBLOCKING (r = virConnectClose (conn));
 287   CHECK_ERROR (r == -1, conn, "virConnectClose");
 288
 289   /* So that we don't double-free in the finalizer: */
 290   Connect_val (connv) = NULL;
 291
 292   CAMLreturn (Val_unit);
 293 }
 294
 295 CAMLprim value
 296 ocaml_libvirt_connect_get_type (value connv)
 297 {
 298   CAMLparam1 (connv);
 299   CAMLlocal1 (rv);
 300   virConnectPtr conn = Connect_val (connv);
 301   const char *r;
 302
 303   NONBLOCKING (r = virConnectGetType (conn));
 304   CHECK_ERROR (!r, conn, "virConnectGetType");
 305
 306   rv = caml_copy_string (r);
 307   CAMLreturn (rv);
 308 }
 309
 310 CAMLprim value
 311 ocaml_libvirt_connect_get_version (value connv)
 312 {
 313   CAMLparam1 (connv);
 314   virConnectPtr conn = Connect_val (connv);
 315   unsigned long hvVer;
 316   int r;
 317
 318   NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
 319   CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
 320
 321   CAMLreturn (Val_int (hvVer));
 322 }
 323
 324 CAMLprim value
 325 ocaml_libvirt_connect_get_hostname (value connv)
 326 {
 327 #ifdef HAVE_VIRCONNECTGETHOSTNAME
 328   CAMLparam1 (connv);
 329   CAMLlocal1 (rv);
 330   virConnectPtr conn = Connect_val (connv);
 331   char *r;
 332
 333   WEAK_SYMBOL_CHECK (virConnectGetHostname);
 334   NONBLOCKING (r = virConnectGetHostname (conn));
 335   CHECK_ERROR (!r, conn, "virConnectGetHostname");
 336
 337   rv = caml_copy_string (r);
 338   free (r);
 339   CAMLreturn (rv);
 340 #else
 341   NOT_SUPPORTED ("virConnectGetHostname");
 342 #endif
 343 }
 344
 345 CAMLprim value
 346 ocaml_libvirt_connect_get_uri (value connv)
 347 {
 348 #ifdef HAVE_VIRCONNECTGETURI
 349   CAMLparam1 (connv);
 350   CAMLlocal1 (rv);
 351   virConnectPtr conn = Connect_val (connv);
 352   char *r;
 353
 354   WEAK_SYMBOL_CHECK (virConnectGetURI);
 355   NONBLOCKING (r = virConnectGetURI (conn));
 356   CHECK_ERROR (!r, conn, "virConnectGetURI");
 357
 358   rv = caml_copy_string (r);
 359   free (r);
 360   CAMLreturn (rv);
 361 #else
 362   NOT_SUPPORTED ("virConnectGetURI");
 363 #endif
 364 }
 365
 366 CAMLprim value
 367 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
 368 {
 369   CAMLparam2 (connv, typev);
 370   virConnectPtr conn = Connect_val (connv);
 371   const char *type = Optstring_val (typev);
 372   int r;
 373
 374   NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
 375   CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
 376
 377   CAMLreturn (Val_int (r));
 378 }
 379
 380 CAMLprim value
 381 ocaml_libvirt_connect_list_domains (value connv, value iv)
 382 {
 383   CAMLparam2 (connv, iv);
 384   CAMLlocal1 (rv);
 385   virConnectPtr conn = Connect_val (connv);
 386   int i = Int_val (iv);
 387   int ids[i], r;
 388
 389   NONBLOCKING (r = virConnectListDomains (conn, ids, i));
 390   CHECK_ERROR (r == -1, conn, "virConnectListDomains");
 391
 392   rv = caml_alloc (r, 0);
 393   for (i = 0; i < r; ++i)
 394     Store_field (rv, i, Val_int (ids[i]));
 395
 396   CAMLreturn (rv);
 397 }
 398
 399 CAMLprim value
 400 ocaml_libvirt_connect_num_of_domains (value connv)
 401 {
 402   CAMLparam1 (connv);
 403   virConnectPtr conn = Connect_val (connv);
 404   int r;
 405
 406   NONBLOCKING (r = virConnectNumOfDomains (conn));
 407   CHECK_ERROR (r == -1, conn, "virConnectNumOfDomains");
 408
 409   CAMLreturn (Val_int (r));
 410 }
 411
 412 CAMLprim value
 413 ocaml_libvirt_connect_get_capabilities (value connv)
 414 {
 415   CAMLparam1 (connv);
 416   CAMLlocal1 (rv);
 417   virConnectPtr conn = Connect_val (connv);
 418   char *r;
 419
 420   NONBLOCKING (r = virConnectGetCapabilities (conn));
 421   CHECK_ERROR (!r, conn, "virConnectGetCapabilities");
 422
 423   rv = caml_copy_string (r);
 424   free (r);
 425
 426   CAMLreturn (rv);
 427 }
 428
 429 CAMLprim value
 430 ocaml_libvirt_connect_num_of_defined_domains (value connv)
 431 {
 432   CAMLparam1 (connv);
 433   virConnectPtr conn = Connect_val (connv);
 434   int r;
 435
 436   NONBLOCKING (r = virConnectNumOfDefinedDomains (conn));
 437   CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedDomains");
 438
 439   CAMLreturn (Val_int (r));
 440 }
 441
 442 CAMLprim value
 443 ocaml_libvirt_connect_list_defined_domains (value connv, value iv)
 444 {
 445   CAMLparam2 (connv, iv);
 446   CAMLlocal2 (rv, strv);
 447   virConnectPtr conn = Connect_val (connv);
 448   int i = Int_val (iv);
 449   char *names[i];
 450   int r;
 451
 452   NONBLOCKING (r = virConnectListDefinedDomains (conn, names, i));
 453   CHECK_ERROR (r == -1, conn, "virConnectListDefinedDomains");
 454
 455   rv = caml_alloc (r, 0);
 456   for (i = 0; i < r; ++i) {
 457     strv = caml_copy_string (names[i]);
 458     Store_field (rv, i, strv);
 459     free (names[i]);
 460   }
 461
 462   CAMLreturn (rv);
 463 }
 464
 465 CAMLprim value
 466 ocaml_libvirt_connect_num_of_networks (value connv)
 467 {
 468   CAMLparam1 (connv);
 469   virConnectPtr conn = Connect_val (connv);
 470   int r;
 471
 472   NONBLOCKING (r = virConnectNumOfNetworks (conn));
 473   CHECK_ERROR (r == -1, conn, "virConnectNumOfNetworks");
 474
 475   CAMLreturn (Val_int (r));
 476 }
 477
 478 CAMLprim value
 479 ocaml_libvirt_connect_list_networks (value connv, value iv)
 480 {
 481   CAMLparam2 (connv, iv);
 482   CAMLlocal2 (rv, strv);
 483   virConnectPtr conn = Connect_val (connv);
 484   int i = Int_val (iv);
 485   char *names[i];
 486   int r;
 487
 488   NONBLOCKING (r = virConnectListNetworks (conn, names, i));
 489   CHECK_ERROR (r == -1, conn, "virConnectListNetworks");
 490
 491   rv = caml_alloc (r, 0);
 492   for (i = 0; i < r; ++i) {
 493     strv = caml_copy_string (names[i]);
 494     Store_field (rv, i, strv);
 495     free (names[i]);
 496   }
 497
 498   CAMLreturn (rv);
 499 }
 500
 501 CAMLprim value
 502 ocaml_libvirt_connect_num_of_defined_networks (value connv)
 503 {
 504   CAMLparam1 (connv);
 505   virConnectPtr conn = Connect_val (connv);
 506   int r;
 507
 508   NONBLOCKING (r = virConnectNumOfDefinedNetworks (conn));
 509   CHECK_ERROR (r == -1, conn, "virConnectNumOfDefinedNetworks");
 510
 511   CAMLreturn (Val_int (r));
 512 }
 513
 514 CAMLprim value
 515 ocaml_libvirt_connect_list_defined_networks (value connv, value iv)
 516 {
 517   CAMLparam2 (connv, iv);
 518   CAMLlocal2 (rv, strv);
 519   virConnectPtr conn = Connect_val (connv);
 520   int i = Int_val (iv);
 521   char *names[i];
 522   int r;
 523
 524   NONBLOCKING (r = virConnectListDefinedNetworks (conn, names, i));
 525   CHECK_ERROR (r == -1, conn, "virConnectListDefinedNetworks");
 526
 527   rv = caml_alloc (r, 0);
 528   for (i = 0; i < r; ++i) {
 529     strv = caml_copy_string (names[i]);
 530     Store_field (rv, i, strv);
 531     free (names[i]);
 532   }
 533
 534   CAMLreturn (rv);
 535 }
 536
 537 CAMLprim value
 538 ocaml_libvirt_connect_get_node_info (value connv)
 539 {
 540   CAMLparam1 (connv);
 541   CAMLlocal2 (rv, v);
 542   virConnectPtr conn = Connect_val (connv);
 543   virNodeInfo info;
 544   int r;
 545
 546   NONBLOCKING (r = virNodeGetInfo (conn, &info));
 547   CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
 548
 549   rv = caml_alloc (8, 0);
 550   v = caml_copy_string (info.model); Store_field (rv, 0, v);
 551   v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
 552   Store_field (rv, 2, Val_int (info.cpus));
 553   Store_field (rv, 3, Val_int (info.mhz));
 554   Store_field (rv, 4, Val_int (info.nodes));
 555   Store_field (rv, 5, Val_int (info.sockets));
 556   Store_field (rv, 6, Val_int (info.cores));
 557   Store_field (rv, 7, Val_int (info.threads));
 558
 559   CAMLreturn (rv);
 560 }
 561
 562 CAMLprim value
 563 ocaml_libvirt_connect_node_get_free_memory (value connv)
 564 {
 565 #ifdef HAVE_VIRNODEGETFREEMEMORY
 566   CAMLparam1 (connv);
 567   CAMLlocal1 (rv);
 568   virConnectPtr conn = Connect_val (connv);
 569   unsigned long long r;
 570
 571   WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
 572   NONBLOCKING (r = virNodeGetFreeMemory (conn));
 573   CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
 574
 575   rv = caml_copy_int64 ((int64) r);
 576   CAMLreturn (rv);
 577 #else
 578   NOT_SUPPORTED ("virNodeGetFreeMemory");
 579 #endif
 580 }
 581
 582 CAMLprim value
 583 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
 584                                                   value startv, value maxv)
 585 {
 586 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
 587   CAMLparam3 (connv, startv, maxv);
 588   CAMLlocal2 (rv, iv);
 589   virConnectPtr conn = Connect_val (connv);
 590   int start = Int_val (startv);
 591   int max = Int_val (maxv);
 592   int r, i;
 593   unsigned long long freemems[max];
 594
 595   WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
 596   NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
 597   CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
 598
 599   rv = caml_alloc (r, 0);
 600   for (i = 0; i < r; ++i) {
 601     iv = caml_copy_int64 ((int64) freemems[i]);
 602     Store_field (rv, i, iv);
 603   }
 604
 605   CAMLreturn (rv);
 606 #else
 607   NOT_SUPPORTED ("virNodeGetCellsFreeMemory");
 608 #endif
 609 }
 610
 611 CAMLprim value
 612 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
 613 {
 614   CAMLparam2 (connv, xmlv);
 615   CAMLlocal1 (rv);
 616   virConnectPtr conn = Connect_val (connv);
 617   char *xml = String_val (xmlv);
 618   virDomainPtr r;
 619
 620   NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0));
 621   CHECK_ERROR (!r, conn, "virDomainCreateLinux");
 622
 623   rv = Val_domain (r, connv);
 624   CAMLreturn (rv);
 625 }
 626
 627 CAMLprim value
 628 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
 629 {
 630   CAMLparam2 (connv, iv);
 631   CAMLlocal1 (rv);
 632   virConnectPtr conn = Connect_val (connv);
 633   int i = Int_val (iv);
 634   virDomainPtr r;
 635
 636   NONBLOCKING (r = virDomainLookupByID (conn, i));
 637   CHECK_ERROR (!r, conn, "virDomainLookupByID");
 638
 639   rv = Val_domain (r, connv);
 640   CAMLreturn (rv);
 641 }
 642
 643 CAMLprim value
 644 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
 645 {
 646   CAMLparam2 (connv, uuidv);
 647   CAMLlocal1 (rv);
 648   virConnectPtr conn = Connect_val (connv);
 649   char *uuid = String_val (uuidv);
 650   virDomainPtr r;
 651
 652   NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid));
 653   CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
 654
 655   rv = Val_domain (r, connv);
 656   CAMLreturn (rv);
 657 }
 658
 659 CAMLprim value
 660 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
 661 {
 662   CAMLparam2 (connv, uuidv);
 663   CAMLlocal1 (rv);
 664   virConnectPtr conn = Connect_val (connv);
 665   char *uuid = String_val (uuidv);
 666   virDomainPtr r;
 667
 668   NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid));
 669   CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
 670
 671   rv = Val_domain (r, connv);
 672   CAMLreturn (rv);
 673 }
 674
 675 CAMLprim value
 676 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
 677 {
 678   CAMLparam2 (connv, namev);
 679   CAMLlocal1 (rv);
 680   virConnectPtr conn = Connect_val (connv);
 681   char *name = String_val (namev);
 682   virDomainPtr r;
 683
 684   NONBLOCKING (r = virDomainLookupByName (conn, name));
 685   CHECK_ERROR (!r, conn, "virDomainLookupByName");
 686
 687   rv = Val_domain (r, connv);
 688   CAMLreturn (rv);
 689 }
 690
 691 CAMLprim value
 692 ocaml_libvirt_domain_destroy (value domv)
 693 {
 694   CAMLparam1 (domv);
 695   virDomainPtr dom = Domain_val (domv);
 696   virConnectPtr conn = Connect_domv (domv);
 697   int r;
 698
 699   NONBLOCKING (r = virDomainDestroy (dom));
 700   CHECK_ERROR (r == -1, conn, "virDomainDestroy");
 701
 702   /* So that we don't double-free in the finalizer: */
 703   Domain_val (domv) = NULL;
 704
 705   CAMLreturn (Val_unit);
 706 }
 707
 708 CAMLprim value
 709 ocaml_libvirt_domain_free (value domv)
 710 {
 711   CAMLparam1 (domv);
 712   virDomainPtr dom = Domain_val (domv);
 713   virConnectPtr conn = Connect_domv (domv);
 714   int r;
 715
 716   NONBLOCKING (r = virDomainFree (dom));
 717   CHECK_ERROR (r == -1, conn, "virDomainFree");
 718
 719   /* So that we don't double-free in the finalizer: */
 720   Domain_val (domv) = NULL;
 721
 722   CAMLreturn (Val_unit);
 723 }
 724
 725 CAMLprim value
 726 ocaml_libvirt_domain_suspend (value domv)
 727 {
 728   CAMLparam1 (domv);
 729   virDomainPtr dom = Domain_val (domv);
 730   virConnectPtr conn = Connect_domv (domv);
 731   int r;
 732
 733   NONBLOCKING (r = virDomainSuspend (dom));
 734   CHECK_ERROR (r == -1, conn, "virDomainSuspend");
 735
 736   CAMLreturn (Val_unit);
 737 }
 738
 739 CAMLprim value
 740 ocaml_libvirt_domain_resume (value domv)
 741 {
 742   CAMLparam1 (domv);
 743   virDomainPtr dom = Domain_val (domv);
 744   virConnectPtr conn = Connect_domv (domv);
 745   int r;
 746
 747   NONBLOCKING (r = virDomainResume (dom));
 748   CHECK_ERROR (r == -1, conn, "virDomainResume");
 749
 750   CAMLreturn (Val_unit);
 751 }
 752
 753 CAMLprim value
 754 ocaml_libvirt_domain_save (value domv, value pathv)
 755 {
 756   CAMLparam2 (domv, pathv);
 757   virDomainPtr dom = Domain_val (domv);
 758   virConnectPtr conn = Connect_domv (domv);
 759   char *path = String_val (pathv);
 760   int r;
 761
 762   NONBLOCKING (r = virDomainSave (dom, path));
 763   CHECK_ERROR (r == -1, conn, "virDomainSave");
 764
 765   CAMLreturn (Val_unit);
 766 }
 767
 768 CAMLprim value
 769 ocaml_libvirt_domain_restore (value connv, value pathv)
 770 {
 771   CAMLparam2 (connv, pathv);
 772   virConnectPtr conn = Connect_val (connv);
 773   char *path = String_val (pathv);
 774   int r;
 775
 776   NONBLOCKING (r = virDomainRestore (conn, path));
 777   CHECK_ERROR (r == -1, conn, "virDomainRestore");
 778
 779   CAMLreturn (Val_unit);
 780 }
 781
 782 CAMLprim value
 783 ocaml_libvirt_domain_core_dump (value domv, value pathv)
 784 {
 785   CAMLparam2 (domv, pathv);
 786   virDomainPtr dom = Domain_val (domv);
 787   virConnectPtr conn = Connect_domv (domv);
 788   char *path = String_val (pathv);
 789   int r;
 790
 791   NONBLOCKING (r = virDomainCoreDump (dom, path, 0));
 792   CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
 793
 794   CAMLreturn (Val_unit);
 795 }
 796
 797 CAMLprim value
 798 ocaml_libvirt_domain_shutdown (value domv)
 799 {
 800   CAMLparam1 (domv);
 801   virDomainPtr dom = Domain_val (domv);
 802   virConnectPtr conn = Connect_domv (domv);
 803   int r;
 804
 805   NONBLOCKING (r = virDomainShutdown (dom));
 806   CHECK_ERROR (r == -1, conn, "virDomainShutdown");
 807
 808   CAMLreturn (Val_unit);
 809 }
 810
 811 CAMLprim value
 812 ocaml_libvirt_domain_reboot (value domv)
 813 {
 814   CAMLparam1 (domv);
 815   virDomainPtr dom = Domain_val (domv);
 816   virConnectPtr conn = Connect_domv (domv);
 817   int r;
 818
 819   NONBLOCKING (r = virDomainReboot (dom, 0));
 820   CHECK_ERROR (r == -1, conn, "virDomainReboot");
 821
 822   CAMLreturn (Val_unit);
 823 }
 824
 825 CAMLprim value
 826 ocaml_libvirt_domain_get_name (value domv)
 827 {
 828   CAMLparam1 (domv);
 829   CAMLlocal1 (rv);
 830   virDomainPtr dom = Domain_val (domv);
 831   virConnectPtr conn = Connect_domv (domv);
 832   const char *r;
 833
 834   NONBLOCKING (r = virDomainGetName (dom));
 835   CHECK_ERROR (!r, conn, "virDomainGetName");
 836
 837   rv = caml_copy_string (r);
 838   CAMLreturn (rv);
 839 }
 840
 841 CAMLprim value
 842 ocaml_libvirt_domain_get_uuid (value domv)
 843 {
 844   CAMLparam1 (domv);
 845   CAMLlocal1 (rv);
 846   virDomainPtr dom = Domain_val (domv);
 847   virConnectPtr conn = Connect_domv (domv);
 848   unsigned char uuid[VIR_UUID_BUFLEN];
 849   int r;
 850
 851   NONBLOCKING (r = virDomainGetUUID (dom, uuid));
 852   CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
 853
 854   rv = caml_copy_string ((char *) uuid);
 855   CAMLreturn (rv);
 856 }
 857
 858 CAMLprim value
 859 ocaml_libvirt_domain_get_uuid_string (value domv)
 860 {
 861   CAMLparam1 (domv);
 862   CAMLlocal1 (rv);
 863   virDomainPtr dom = Domain_val (domv);
 864   virConnectPtr conn = Connect_domv (domv);
 865   char uuid[VIR_UUID_STRING_BUFLEN];
 866   int r;
 867
 868   NONBLOCKING (r = virDomainGetUUIDString (dom, uuid));
 869   CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
 870
 871   rv = caml_copy_string (uuid);
 872   CAMLreturn (rv);
 873 }
 874
 875 CAMLprim value
 876 ocaml_libvirt_domain_get_id (value domv)
 877 {
 878   CAMLparam1 (domv);
 879   virDomainPtr dom = Domain_val (domv);
 880   virConnectPtr conn = Connect_domv (domv);
 881   unsigned int r;
 882
 883   NONBLOCKING (r = virDomainGetID (dom));
 884   /* There's a bug in libvirt which means that if you try to get
 885    * the ID of a defined-but-not-running domain, it returns -1,
 886    * and there's no way to distinguish that from an error.
 887    */
 888   CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
 889
 890   CAMLreturn (Val_int ((int) r));
 891 }
 892
 893 CAMLprim value
 894 ocaml_libvirt_domain_get_os_type (value domv)
 895 {
 896   CAMLparam1 (domv);
 897   CAMLlocal1 (rv);
 898   virDomainPtr dom = Domain_val (domv);
 899   virConnectPtr conn = Connect_domv (domv);
 900   char *r;
 901
 902   NONBLOCKING (r = virDomainGetOSType (dom));
 903   CHECK_ERROR (!r, conn, "virDomainGetOSType");
 904
 905   rv = caml_copy_string (r);
 906   free (r);
 907   CAMLreturn (rv);
 908 }
 909
 910 CAMLprim value
 911 ocaml_libvirt_domain_get_max_memory (value domv)
 912 {
 913   CAMLparam1 (domv);
 914   CAMLlocal1 (rv);
 915   virDomainPtr dom = Domain_val (domv);
 916   virConnectPtr conn = Connect_domv (domv);
 917   unsigned long r;
 918
 919   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 920   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 921
 922   rv = caml_copy_int64 (r);
 923   CAMLreturn (rv);
 924 }
 925
 926 CAMLprim value
 927 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 928 {
 929   CAMLparam2 (domv, memv);
 930   virDomainPtr dom = Domain_val (domv);
 931   virConnectPtr conn = Connect_domv (domv);
 932   unsigned long mem = Int64_val (memv);
 933   int r;
 934
 935   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 936   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 937
 938   CAMLreturn (Val_unit);
 939 }
 940
 941 CAMLprim value
 942 ocaml_libvirt_domain_set_memory (value domv, value memv)
 943 {
 944   CAMLparam2 (domv, memv);
 945   virDomainPtr dom = Domain_val (domv);
 946   virConnectPtr conn = Connect_domv (domv);
 947   unsigned long mem = Int64_val (memv);
 948   int r;
 949
 950   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 951   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 952
 953   CAMLreturn (Val_unit);
 954 }
 955
 956 CAMLprim value
 957 ocaml_libvirt_domain_get_info (value domv)
 958 {
 959   CAMLparam1 (domv);
 960   CAMLlocal2 (rv, v);
 961   virDomainPtr dom = Domain_val (domv);
 962   virConnectPtr conn = Connect_domv (domv);
 963   virDomainInfo info;
 964   int r;
 965
 966   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 967   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 968
 969   rv = caml_alloc (5, 0);
 970   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 971   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 972   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 973   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 974   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 975
 976   CAMLreturn (rv);
 977 }
 978
 979 CAMLprim value
 980 ocaml_libvirt_domain_get_xml_desc (value domv)
 981 {
 982   CAMLparam1 (domv);
 983   CAMLlocal1 (rv);
 984   virDomainPtr dom = Domain_val (domv);
 985   virConnectPtr conn = Connect_domv (domv);
 986   char *r;
 987
 988   NONBLOCKING (r = virDomainGetXMLDesc (dom, 0));
 989   CHECK_ERROR (!r, conn, "virDomainGetXMLDesc");
 990
 991   rv = caml_copy_string (r);
 992   free (r);
 993   CAMLreturn (rv);
 994 }
 995
 996 CAMLprim value
 997 ocaml_libvirt_domain_get_scheduler_type (value domv)
 998 {
 999 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
1000   CAMLparam1 (domv);
1001   CAMLlocal2 (rv, strv);
1002   virDomainPtr dom = Domain_val (domv);
1003   virConnectPtr conn = Connect_domv (domv);
1004   char *r;
1005   int nparams;
1006
1007   WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
1008   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
1009   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
1010
1011   rv = caml_alloc_tuple (2);
1012   strv = caml_copy_string (r); Store_field (rv, 0, strv);
1013   free (r);
1014   Store_field (rv, 1, nparams);
1015   CAMLreturn (rv);
1016 #else
1017   NOT_SUPPORTED ("virDomainGetSchedulerType");
1018 #endif
1019 }
1020
1021 CAMLprim value
1022 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
1023 {
1024 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
1025   CAMLparam2 (domv, nparamsv);
1026   CAMLlocal4 (rv, v, v2, v3);
1027   virDomainPtr dom = Domain_val (domv);
1028   virConnectPtr conn = Connect_domv (domv);
1029   int nparams = Int_val (nparamsv);
1030   virSchedParameter params[nparams];
1031   int r, i;
1032
1033   WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
1034   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
1035   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
1036
1037   rv = caml_alloc (nparams, 0);
1038   for (i = 0; i < nparams; ++i) {
1039     v = caml_alloc_tuple (2); Store_field (rv, i, v);
1040     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
1041     switch (params[i].type) {
1042     case VIR_DOMAIN_SCHED_FIELD_INT:
1043       v2 = caml_alloc (1, 0);
1044       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
1045       break;
1046     case VIR_DOMAIN_SCHED_FIELD_UINT:
1047       v2 = caml_alloc (1, 1);
1048       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
1049       break;
1050     case VIR_DOMAIN_SCHED_FIELD_LLONG:
1051       v2 = caml_alloc (1, 2);
1052       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
1053       break;
1054     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
1055       v2 = caml_alloc (1, 3);
1056       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
1057       break;
1058     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
1059       v2 = caml_alloc (1, 4);
1060       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
1061       break;
1062     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
1063       v2 = caml_alloc (1, 5);
1064       Store_field (v2, 0, Val_int (params[i].value.b));
1065       break;
1066     default:
1067       caml_failwith ((char *)__FUNCTION__);
1068     }
1069     Store_field (v, 1, v2);
1070   }
1071   CAMLreturn (rv);
1072 #else
1073   NOT_SUPPORTED ("virDomainGetSchedulerParameters");
1074 #endif
1075 }
1076
1077 CAMLprim value
1078 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
1079 {
1080 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
1081   CAMLparam2 (domv, paramsv);
1082   CAMLlocal1 (v);
1083   virDomainPtr dom = Domain_val (domv);
1084   virConnectPtr conn = Connect_domv (domv);
1085   int nparams = Wosize_val (paramsv);
1086   virSchedParameter params[nparams];
1087   int r, i;
1088   char *name;
1089
1090   for (i = 0; i < nparams; ++i) {
1091     v = Field (paramsv, i);     /* Points to the two-element tuple. */
1092     name = String_val (Field (v, 0));
1093     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
1094     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
1095     v = Field (v, 1);           /* Points to the sched_param_value block. */
1096     switch (Tag_val (v)) {
1097     case 0:
1098       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
1099       params[i].value.i = Int32_val (Field (v, 0));
1100       break;
1101     case 1:
1102       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
1103       params[i].value.ui = Int32_val (Field (v, 0));
1104       break;
1105     case 2:
1106       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
1107       params[i].value.l = Int64_val (Field (v, 0));
1108       break;
1109     case 3:
1110       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
1111       params[i].value.ul = Int64_val (Field (v, 0));
1112       break;
1113     case 4:
1114       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
1115       params[i].value.d = Double_val (Field (v, 0));
1116       break;
1117     case 5:
1118       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
1119       params[i].value.b = Int_val (Field (v, 0));
1120       break;
1121     default:
1122       caml_failwith ((char *)__FUNCTION__);
1123     }
1124   }
1125
1126   WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
1127   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
1128   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
1129
1130   CAMLreturn (Val_unit);
1131 #else
1132   NOT_SUPPORTED ("virDomainSetSchedulerParameters");
1133 #endif
1134 }
1135
1136 CAMLprim value
1137 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
1138 {
1139   CAMLparam2 (connv, xmlv);
1140   CAMLlocal1 (rv);
1141   virConnectPtr conn = Connect_val (connv);
1142   char *xml = String_val (xmlv);
1143   virDomainPtr r;
1144
1145   NONBLOCKING (r = virDomainDefineXML (conn, xml));
1146   CHECK_ERROR (!r, conn, "virDomainDefineXML");
1147
1148   rv = Val_domain (r, connv);
1149   CAMLreturn (rv);
1150 }
1151
1152 CAMLprim value
1153 ocaml_libvirt_domain_undefine (value domv)
1154 {
1155   CAMLparam1 (domv);
1156   virDomainPtr dom = Domain_val (domv);
1157   virConnectPtr conn = Connect_domv (domv);
1158   int r;
1159
1160   NONBLOCKING (r = virDomainUndefine (dom));
1161   CHECK_ERROR (r == -1, conn, "virDomainUndefine");
1162
1163   CAMLreturn (Val_unit);
1164 }
1165
1166 CAMLprim value
1167 ocaml_libvirt_domain_create (value domv)
1168 {
1169   CAMLparam1 (domv);
1170   virDomainPtr dom = Domain_val (domv);
1171   virConnectPtr conn = Connect_domv (domv);
1172   int r;
1173
1174   NONBLOCKING (r = virDomainCreate (dom));
1175   CHECK_ERROR (r == -1, conn, "virDomainCreate");
1176
1177   CAMLreturn (Val_unit);
1178 }
1179
1180 CAMLprim value
1181 ocaml_libvirt_domain_get_autostart (value domv)
1182 {
1183   CAMLparam1 (domv);
1184   virDomainPtr dom = Domain_val (domv);
1185   virConnectPtr conn = Connect_domv (domv);
1186   int r, autostart;
1187
1188   NONBLOCKING (r = virDomainGetAutostart (dom, &autostart));
1189   CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
1190
1191   CAMLreturn (autostart ? Val_true : Val_false);
1192 }
1193
1194 CAMLprim value
1195 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
1196 {
1197   CAMLparam2 (domv, autostartv);
1198   virDomainPtr dom = Domain_val (domv);
1199   virConnectPtr conn = Connect_domv (domv);
1200   int r, autostart = autostartv == Val_true ? 1 : 0;
1201
1202   NONBLOCKING (r = virDomainSetAutostart (dom, autostart));
1203   CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
1204
1205   CAMLreturn (Val_unit);
1206 }
1207
1208 CAMLprim value
1209 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
1210 {
1211   CAMLparam2 (domv, nvcpusv);
1212   virDomainPtr dom = Domain_val (domv);
1213   virConnectPtr conn = Connect_domv (domv);
1214   int r, nvcpus = Int_val (nvcpusv);
1215
1216   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
1217   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
1218
1219   CAMLreturn (Val_unit);
1220 }
1221
1222 CAMLprim value
1223 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
1224 {
1225   CAMLparam3 (domv, vcpuv, cpumapv);
1226   virDomainPtr dom = Domain_val (domv);
1227   virConnectPtr conn = Connect_domv (domv);
1228   int maplen = caml_string_length (cpumapv);
1229   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
1230   int vcpu = Int_val (vcpuv);
1231   int r;
1232
1233   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
1234   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1235
1236   CAMLreturn (Val_unit);
1237 }
1238
1239 CAMLprim value
1240 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
1241 {
1242   CAMLparam3 (domv, maxinfov, maplenv);
1243   CAMLlocal5 (rv, infov, strv, v, v2);
1244   virDomainPtr dom = Domain_val (domv);
1245   virConnectPtr conn = Connect_domv (domv);
1246   int maxinfo = Int_val (maxinfov);
1247   int maplen = Int_val (maplenv);
1248   virVcpuInfo info[maxinfo];
1249   unsigned char cpumaps[maxinfo * maplen];
1250   int r, i;
1251
1252   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
1253   memset (cpumaps, 0, maxinfo * maplen);
1254
1255   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
1256   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
1257
1258   /* Copy the virVcpuInfo structures. */
1259   infov = caml_alloc (maxinfo, 0);
1260   for (i = 0; i < maxinfo; ++i) {
1261     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
1262     Store_field (v2, 0, Val_int (info[i].number));
1263     Store_field (v2, 1, Val_int (info[i].state));
1264     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
1265     Store_field (v2, 3, Val_int (info[i].cpu));
1266   }
1267
1268   /* Copy the bitmap. */
1269   strv = caml_alloc_string (maxinfo * maplen);
1270   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
1271
1272   /* Allocate the tuple and return it. */
1273   rv = caml_alloc_tuple (3);
1274   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
1275   Store_field (rv, 1, infov);
1276   Store_field (rv, 2, strv);
1277
1278   CAMLreturn (rv);
1279 }
1280
1281 CAMLprim value
1282 ocaml_libvirt_domain_get_max_vcpus (value domv)
1283 {
1284   CAMLparam1 (domv);
1285   virDomainPtr dom = Domain_val (domv);
1286   virConnectPtr conn = Connect_domv (domv);
1287   int r;
1288
1289   NONBLOCKING (r = virDomainGetMaxVcpus (dom));
1290   CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
1291
1292   CAMLreturn (Val_int (r));
1293 }
1294
1295 CAMLprim value
1296 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
1297 {
1298   CAMLparam2 (domv, xmlv);
1299   virDomainPtr dom = Domain_val (domv);
1300   virConnectPtr conn = Connect_domv (domv);
1301   char *xml = String_val (xmlv);
1302   int r;
1303
1304   NONBLOCKING (r = virDomainAttachDevice (dom, xml));
1305   CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
1306
1307   CAMLreturn (Val_unit);
1308 }
1309
1310 CAMLprim value
1311 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
1312 {
1313   CAMLparam2 (domv, xmlv);
1314   virDomainPtr dom = Domain_val (domv);
1315   virConnectPtr conn = Connect_domv (domv);
1316   char *xml = String_val (xmlv);
1317   int r;
1318
1319   NONBLOCKING (r = virDomainDetachDevice (dom, xml));
1320   CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
1321
1322   CAMLreturn (Val_unit);
1323 }
1324
1325 CAMLprim value
1326 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
1327 {
1328 #ifdef HAVE_VIRDOMAINMIGRATE
1329   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
1330   CAMLxparam2 (optbandwidthv, unitv);
1331   CAMLlocal2 (flagv, rv);
1332   virDomainPtr dom = Domain_val (domv);
1333   virConnectPtr conn = Connect_domv (domv);
1334   virConnectPtr dconn = Connect_val (dconnv);
1335   int flags = 0;
1336   const char *dname = Optstring_val (optdnamev);
1337   const char *uri = Optstring_val (opturiv);
1338   unsigned long bandwidth;
1339   virDomainPtr r;
1340
1341   /* Iterate over the list of flags. */
1342   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
1343     {
1344       flagv = Field (flagsv, 0);
1345       if (flagv == Int_val(0))
1346         flags |= VIR_MIGRATE_LIVE;
1347     }
1348
1349   if (optbandwidthv == Val_int (0)) /* None */
1350     bandwidth = 0;
1351   else                          /* Some bandwidth */
1352     bandwidth = Int_val (Field (optbandwidthv, 0));
1353
1354   WEAK_SYMBOL_CHECK (virDomainMigrate);
1355   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
1356   CHECK_ERROR (!r, conn, "virDomainMigrate");
1357
1358   rv = Val_domain (r, dconnv);
1359
1360   CAMLreturn (rv);
1361
1362 #else /* virDomainMigrate not supported */
1363   NOT_SUPPORTED ("virDomainMigrate");
1364 #endif
1365 }
1366
1367 CAMLprim value
1368 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
1369 {
1370   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
1371                                               argv[3], argv[4], argv[5],
1372                                               argv[6]);
1373 }
1374
1375 CAMLprim value
1376 ocaml_libvirt_domain_block_stats (value domv, value pathv)
1377 {
1378 #if HAVE_VIRDOMAINBLOCKSTATS
1379   CAMLparam2 (domv, pathv);
1380   CAMLlocal2 (rv,v);
1381   virDomainPtr dom = Domain_val (domv);
1382   virConnectPtr conn = Connect_domv (domv);
1383   char *path = String_val (pathv);
1384   struct _virDomainBlockStats stats;
1385   int r;
1386
1387   WEAK_SYMBOL_CHECK (virDomainBlockStats);
1388   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
1389   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
1390
1391   rv = caml_alloc (5, 0);
1392   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
1393   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
1394   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
1395   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
1396   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
1397
1398   CAMLreturn (rv);
1399 #else
1400   NOT_SUPPORTED ("virDomainBlockStats");
1401 #endif
1402 }
1403
1404 CAMLprim value
1405 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
1406 {
1407 #if HAVE_VIRDOMAININTERFACESTATS
1408   CAMLparam2 (domv, pathv);
1409   CAMLlocal2 (rv,v);
1410   virDomainPtr dom = Domain_val (domv);
1411   virConnectPtr conn = Connect_domv (domv);
1412   char *path = String_val (pathv);
1413   struct _virDomainInterfaceStats stats;
1414   int r;
1415
1416   WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
1417   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
1418   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
1419
1420   rv = caml_alloc (8, 0);
1421   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
1422   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
1423   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
1424   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
1425   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
1426   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
1427   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
1428   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
1429
1430   CAMLreturn (rv);
1431 #else
1432   NOT_SUPPORTED ("virDomainInterfaceStats");
1433 #endif
1434 }
1435
1436 CAMLprim value
1437 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
1438 {
1439   CAMLparam2 (connv, namev);
1440   CAMLlocal1 (rv);
1441   virConnectPtr conn = Connect_val (connv);
1442   char *name = String_val (namev);
1443   virNetworkPtr r;
1444
1445   NONBLOCKING (r = virNetworkLookupByName (conn, name));
1446   CHECK_ERROR (!r, conn, "virNetworkLookupByName");
1447
1448   rv = Val_network (r, connv);
1449   CAMLreturn (rv);
1450 }
1451
1452 CAMLprim value
1453 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
1454 {
1455   CAMLparam2 (connv, uuidv);
1456   CAMLlocal1 (rv);
1457   virConnectPtr conn = Connect_val (connv);
1458   char *uuid = String_val (uuidv);
1459   virNetworkPtr r;
1460
1461   NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid));
1462   CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
1463
1464   rv = Val_network (r, connv);
1465   CAMLreturn (rv);
1466 }
1467
1468 CAMLprim value
1469 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
1470 {
1471   CAMLparam2 (connv, uuidv);
1472   CAMLlocal1 (rv);
1473   virConnectPtr conn = Connect_val (connv);
1474   char *uuid = String_val (uuidv);
1475   virNetworkPtr r;
1476
1477   NONBLOCKING (r = virNetworkLookupByUUIDString (conn, uuid));
1478   CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
1479
1480   rv = Val_network (r, connv);
1481   CAMLreturn (rv);
1482 }
1483
1484 CAMLprim value
1485 ocaml_libvirt_network_create_xml (value connv, value xmlv)
1486 {
1487   CAMLparam2 (connv, xmlv);
1488   CAMLlocal1 (rv);
1489   virConnectPtr conn = Connect_val (connv);
1490   char *xml = String_val (xmlv);
1491   virNetworkPtr r;
1492
1493   NONBLOCKING (r = virNetworkCreateXML (conn, xml));
1494   CHECK_ERROR (!r, conn, "virNetworkCreateXML");
1495
1496   rv = Val_network (r, connv);
1497   CAMLreturn (rv);
1498 }
1499
1500 CAMLprim value
1501 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1502 {
1503   CAMLparam2 (connv, xmlv);
1504   CAMLlocal1 (rv);
1505   virConnectPtr conn = Connect_val (connv);
1506   char *xml = String_val (xmlv);
1507   virNetworkPtr r;
1508
1509   NONBLOCKING (r = virNetworkDefineXML (conn, xml));
1510   CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1511
1512   rv = Val_network (r, connv);
1513   CAMLreturn (rv);
1514 }
1515
1516 CAMLprim value
1517 ocaml_libvirt_network_undefine (value netv)
1518 {
1519   CAMLparam1 (netv);
1520   virNetworkPtr net = Network_val (netv);
1521   virConnectPtr conn = Connect_netv (netv);
1522   int r;
1523
1524   NONBLOCKING (r = virNetworkUndefine (net));
1525   CHECK_ERROR (r == -1, conn, "virNetworkUndefine");
1526
1527   CAMLreturn (Val_unit);
1528 }
1529
1530 CAMLprim value
1531 ocaml_libvirt_network_create (value netv)
1532 {
1533   CAMLparam1 (netv);
1534   virNetworkPtr net = Network_val (netv);
1535   virConnectPtr conn = Connect_netv (netv);
1536   int r;
1537
1538   NONBLOCKING (r = virNetworkCreate (net));
1539   CHECK_ERROR (r == -1, conn, "virNetworkCreate");
1540
1541   CAMLreturn (Val_unit);
1542 }
1543
1544 CAMLprim value
1545 ocaml_libvirt_network_destroy (value netv)
1546 {
1547   CAMLparam1 (netv);
1548   virNetworkPtr net = Network_val (netv);
1549   virConnectPtr conn = Connect_netv (netv);
1550   int r;
1551
1552   NONBLOCKING (r = virNetworkDestroy (net));
1553   CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1554
1555   /* So that we don't double-free in the finalizer: */
1556   Network_val (netv) = NULL;
1557
1558   CAMLreturn (Val_unit);
1559 }
1560
1561 CAMLprim value
1562 ocaml_libvirt_network_free (value netv)
1563 {
1564   CAMLparam1 (netv);
1565   virNetworkPtr net = Network_val (netv);
1566   virConnectPtr conn = Connect_netv (netv);
1567   int r;
1568
1569   NONBLOCKING (r = virNetworkFree (net));
1570   CHECK_ERROR (r == -1, conn, "virNetworkFree");
1571
1572   /* So that we don't double-free in the finalizer: */
1573   Network_val (netv) = NULL;
1574
1575   CAMLreturn (Val_unit);
1576 }
1577
1578 CAMLprim value
1579 ocaml_libvirt_network_get_name (value netv)
1580 {
1581   CAMLparam1 (netv);
1582   CAMLlocal1 (rv);
1583   virNetworkPtr net = Network_val (netv);
1584   virConnectPtr conn = Connect_netv (netv);
1585   const char *r;
1586
1587   NONBLOCKING (r = virNetworkGetName (net));
1588   CHECK_ERROR (!r, conn, "virNetworkGetName");
1589
1590   rv = caml_copy_string (r);
1591   CAMLreturn (rv);
1592 }
1593
1594 CAMLprim value
1595 ocaml_libvirt_network_get_uuid (value netv)
1596 {
1597   CAMLparam1 (netv);
1598   CAMLlocal1 (rv);
1599   virNetworkPtr net = Network_val (netv);
1600   virConnectPtr conn = Connect_netv (netv);
1601   unsigned char uuid[VIR_UUID_BUFLEN];
1602   int r;
1603
1604   NONBLOCKING (r = virNetworkGetUUID (net, uuid));
1605   CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1606
1607   rv = caml_copy_string ((char *) uuid);
1608   CAMLreturn (rv);
1609 }
1610
1611 CAMLprim value
1612 ocaml_libvirt_network_get_uuid_string (value netv)
1613 {
1614   CAMLparam1 (netv);
1615   CAMLlocal1 (rv);
1616   virNetworkPtr net = Network_val (netv);
1617   virConnectPtr conn = Connect_netv (netv);
1618   char uuid[VIR_UUID_STRING_BUFLEN];
1619   int r;
1620
1621   NONBLOCKING (r = virNetworkGetUUIDString (net, uuid));
1622   CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1623
1624   rv = caml_copy_string (uuid);
1625   CAMLreturn (rv);
1626 }
1627
1628 CAMLprim value
1629 ocaml_libvirt_network_get_xml_desc (value netv)
1630 {
1631   CAMLparam1 (netv);
1632   CAMLlocal1 (rv);
1633   virNetworkPtr net = Network_val (netv);
1634   virConnectPtr conn = Connect_netv (netv);
1635   char *r;
1636
1637   NONBLOCKING (r = virNetworkGetXMLDesc (net, 0));
1638   CHECK_ERROR (!r, conn, "virNetworkGetXMLDesc");
1639
1640   rv = caml_copy_string (r);
1641   free (r);
1642   CAMLreturn (rv);
1643 }
1644
1645 CAMLprim value
1646 ocaml_libvirt_network_get_bridge_name (value netv)
1647 {
1648   CAMLparam1 (netv);
1649   CAMLlocal1 (rv);
1650   virNetworkPtr net = Network_val (netv);
1651   virConnectPtr conn = Connect_netv (netv);
1652   char *r;
1653
1654   NONBLOCKING (r = virNetworkGetBridgeName (net));
1655   CHECK_ERROR (!r, conn, "virNetworkGetBridgeName");
1656
1657   rv = caml_copy_string (r);
1658   free (r);
1659   CAMLreturn (rv);
1660 }
1661
1662 CAMLprim value
1663 ocaml_libvirt_network_get_autostart (value netv)
1664 {
1665   CAMLparam1 (netv);
1666   virNetworkPtr net = Network_val (netv);
1667   virConnectPtr conn = Connect_netv (netv);
1668   int r, autostart;
1669
1670   NONBLOCKING (r = virNetworkGetAutostart (net, &autostart));
1671   CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1672
1673   CAMLreturn (autostart ? Val_true : Val_false);
1674 }
1675
1676 CAMLprim value
1677 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1678 {
1679   CAMLparam2 (netv, autostartv);
1680   virNetworkPtr net = Network_val (netv);
1681   virConnectPtr conn = Connect_netv (netv);
1682   int r, autostart = autostartv == Val_true ? 1 : 0;
1683
1684   NONBLOCKING (r = virNetworkSetAutostart (net, autostart));
1685   CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1686
1687   CAMLreturn (Val_unit);
1688 }
1689
1690 /*----------------------------------------------------------------------*/
1691
1692 CAMLprim value
1693 ocaml_libvirt_virterror_get_last_error (value unitv)
1694 {
1695   CAMLparam1 (unitv);
1696   CAMLlocal1 (rv);
1697   virErrorPtr err = virGetLastError ();
1698
1699   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1700
1701   CAMLreturn (rv);
1702 }
1703
1704 CAMLprim value
1705 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1706 {
1707   CAMLparam1 (connv);
1708   CAMLlocal1 (rv);
1709   virConnectPtr conn = Connect_val (connv);
1710
1711   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1712
1713   CAMLreturn (rv);
1714 }
1715
1716 CAMLprim value
1717 ocaml_libvirt_virterror_reset_last_error (value unitv)
1718 {
1719   CAMLparam1 (unitv);
1720   virResetLastError ();
1721   CAMLreturn (Val_unit);
1722 }
1723
1724 CAMLprim value
1725 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1726 {
1727   CAMLparam1 (connv);
1728   virConnectPtr conn = Connect_val (connv);
1729   virConnResetLastError (conn);
1730   CAMLreturn (Val_unit);
1731 }
1732
1733 /*----------------------------------------------------------------------*/
1734
1735 /* Initialise the library. */
1736 CAMLprim value
1737 ocaml_libvirt_init (value unit)
1738 {
1739   CAMLparam1 (unit);
1740   CAMLlocal1 (rv);
1741   int r;
1742
1743   r = virInitialize ();
1744   CHECK_ERROR (r == -1, NULL, "virInitialize");
1745
1746   CAMLreturn (Val_unit);
1747 }
1748
1749 /*----------------------------------------------------------------------*/
1750
1751 static char *
1752 Optstring_val (value strv)
1753 {
1754   if (strv == Val_int (0))      /* None */
1755     return NULL;
1756   else                          /* Some string */
1757     return String_val (Field (strv, 0));
1758 }
1759
1760 static value
1761 Val_opt (void *ptr, Val_ptr_t Val_ptr)
1762 {
1763   CAMLparam0 ();
1764   CAMLlocal2 (optv, ptrv);
1765
1766   if (ptr) {                    /* Some ptr */
1767     optv = caml_alloc (1, 0);
1768     ptrv = Val_ptr (ptr);
1769     Store_field (optv, 0, ptrv);
1770   } else                        /* None */
1771     optv = Val_int (0);
1772
1773   CAMLreturn (optv);
1774 }
1775
1776 #if 0
1777 static value
1778 option_default (value option, value deflt)
1779 {
1780   if (option == Val_int (0))    /* "None" */
1781     return deflt;
1782   else                          /* "Some 'a" */
1783     return Field (option, 0);
1784 }
1785 #endif
1786
1787 static value
1788 _raise_virterror (virConnectPtr conn, const char *fn)
1789 {
1790   CAMLparam0 ();
1791   CAMLlocal1 (rv);
1792   virErrorPtr errp;
1793   struct _virError err;
1794
1795   errp = conn ? virConnGetLastError (conn) : virGetLastError ();
1796
1797   if (!errp) {
1798     /* Fake a _virError structure. */
1799     memset (&err, 0, sizeof err);
1800     err.code = VIR_ERR_INTERNAL_ERROR;
1801     err.domain = VIR_FROM_NONE;
1802     err.level = VIR_ERR_ERROR;
1803     err.message = (char *) fn;
1804     errp = &err;
1805   }
1806
1807   rv = Val_virterror (errp);
1808   caml_raise_with_arg (*caml_named_value ("ocaml_libvirt_virterror"), rv);
1809
1810   /*NOTREACHED*/
1811   CAMLreturn (Val_unit);
1812 }
1813
1814 /* Convert the virErrorNumber, virErrorDomain and virErrorLevel enums
1815  * into values (longs because they are variants in OCaml).
1816  *
1817  * The enum values are part of the libvirt ABI so they cannot change,
1818  * which means that we can convert these numbers directly into
1819  * OCaml variants (which use the same ordering) very fast.
1820  *
1821  * The tricky part here is when we are linked to a newer version of
1822  * libvirt than the one we were compiled against.  If the newer libvirt
1823  * generates an error code which we don't know about then we need
1824  * to convert it into VIR_*_UNKNOWN (code).
1825  */
1826
1827 #define MAX_VIR_CODE 44 /* VIR_ERR_INVALID_MAC */
1828 #define MAX_VIR_DOMAIN 16 /* VIR_FROM_STATS_LINUX */
1829 #define MAX_VIR_LEVEL VIR_ERR_ERROR
1830
1831 static inline value
1832 Val_err_number (virErrorNumber code)
1833 {
1834   CAMLparam0 ();
1835   CAMLlocal1 (rv);
1836
1837   if (0 <= code && code <= MAX_VIR_CODE)
1838     rv = Val_int (code);
1839   else {
1840     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN (code) */
1841     Store_field (rv, 0, Val_int (code));
1842   }
1843
1844   CAMLreturn (rv);
1845 }
1846
1847 static inline value
1848 Val_err_domain (virErrorDomain code)
1849 {
1850   CAMLparam0 ();
1851   CAMLlocal1 (rv);
1852
1853   if (0 <= code && code <= MAX_VIR_DOMAIN)
1854     rv = Val_int (code);
1855   else {
1856     rv = caml_alloc (1, 0);     /* VIR_FROM_UNKNOWN (code) */
1857     Store_field (rv, 0, Val_int (code));
1858   }
1859
1860   CAMLreturn (rv);
1861 }
1862
1863 static inline value
1864 Val_err_level (virErrorLevel code)
1865 {
1866   CAMLparam0 ();
1867   CAMLlocal1 (rv);
1868
1869   if (0 <= code && code <= MAX_VIR_LEVEL)
1870     rv = Val_int (code);
1871   else {
1872     rv = caml_alloc (1, 0);     /* VIR_ERR_UNKNOWN_LEVEL (code) */
1873     Store_field (rv, 0, Val_int (code));
1874   }
1875
1876   CAMLreturn (rv);
1877 }
1878
1879 /* Convert a virterror to a value. */
1880 static value
1881 Val_virterror (virErrorPtr err)
1882 {
1883   CAMLparam0 ();
1884   CAMLlocal3 (rv, connv, optv);
1885
1886   rv = caml_alloc (12, 0);
1887   Store_field (rv, 0, Val_err_number (err->code));
1888   Store_field (rv, 1, Val_err_domain (err->domain));
1889   Store_field (rv, 2,
1890                Val_opt (err->message, (Val_ptr_t) caml_copy_string));
1891   Store_field (rv, 3, Val_err_level (err->level));
1892
1893   /* conn, dom and net fields, all optional */
1894   if (err->conn) {
1895     connv = Val_connect_no_finalize (err->conn);
1896     optv = caml_alloc (1, 0);
1897     Store_field (optv, 0, connv);
1898     Store_field (rv, 4, optv);  /* Some conn */
1899
1900     if (err->dom) {
1901       optv = caml_alloc (1, 0);
1902       Store_field (optv, 0, Val_domain_no_finalize (err->dom, connv));
1903       Store_field (rv, 5, optv); /* Some (dom, conn) */
1904     }
1905     else
1906       Store_field (rv, 5, Val_int (0)); /* None */
1907     if (err->net) {
1908       optv = caml_alloc (1, 0);
1909       Store_field (optv, 0, Val_network_no_finalize (err->net, connv));
1910       Store_field (rv, 11, optv); /* Some (net, conn) */
1911     } else
1912       Store_field (rv, 11, Val_int (0)); /* None */
1913   } else {
1914     Store_field (rv, 4, Val_int (0)); /* None */
1915     Store_field (rv, 5, Val_int (0)); /* None */
1916     Store_field (rv, 11, Val_int (0)); /* None */
1917   }
1918
1919   Store_field (rv, 6,
1920                Val_opt (err->str1, (Val_ptr_t) caml_copy_string));
1921   Store_field (rv, 7,
1922                Val_opt (err->str2, (Val_ptr_t) caml_copy_string));
1923   Store_field (rv, 8,
1924                Val_opt (err->str3, (Val_ptr_t) caml_copy_string));
1925   Store_field (rv, 9, caml_copy_int32 (err->int1));
1926   Store_field (rv, 10, caml_copy_int32 (err->int2));
1927
1928   CAMLreturn (rv);
1929 }
1930
1931 static void conn_finalize (value);
1932 static void dom_finalize (value);
1933 static void net_finalize (value);
1934
1935 static struct custom_operations conn_custom_operations = {
1936   "conn_custom_operations",
1937   conn_finalize,
1938   custom_compare_default,
1939   custom_hash_default,
1940   custom_serialize_default,
1941   custom_deserialize_default
1942 };
1943
1944 static struct custom_operations dom_custom_operations = {
1945   "dom_custom_operations",
1946   dom_finalize,
1947   custom_compare_default,
1948   custom_hash_default,
1949   custom_serialize_default,
1950   custom_deserialize_default
1951
1952 };
1953
1954 static struct custom_operations net_custom_operations = {
1955   "net_custom_operations",
1956   net_finalize,
1957   custom_compare_default,
1958   custom_hash_default,
1959   custom_serialize_default,
1960   custom_deserialize_default
1961 };
1962
1963 static value
1964 Val_connect (virConnectPtr conn)
1965 {
1966   CAMLparam0 ();
1967   CAMLlocal1 (rv);
1968   rv = caml_alloc_custom (&conn_custom_operations,
1969                           sizeof (virConnectPtr), 0, 1);
1970   Connect_val (rv) = conn;
1971   CAMLreturn (rv);
1972 }
1973
1974 /* This wraps up the raw domain handle (Domain.dom). */
1975 static value
1976 Val_dom (virDomainPtr dom)
1977 {
1978   CAMLparam0 ();
1979   CAMLlocal1 (rv);
1980   rv = caml_alloc_custom (&dom_custom_operations,
1981                           sizeof (virDomainPtr), 0, 1);
1982   Dom_val (rv) = dom;
1983   CAMLreturn (rv);
1984 }
1985
1986 /* This wraps up the raw network handle (Network.net). */
1987 static value
1988 Val_net (virNetworkPtr net)
1989 {
1990   CAMLparam0 ();
1991   CAMLlocal1 (rv);
1992   rv = caml_alloc_custom (&net_custom_operations,
1993                           sizeof (virNetworkPtr), 0, 1);
1994   Net_val (rv) = net;
1995   CAMLreturn (rv);
1996 }
1997
1998 /* No-finalize versions of Val_connect, Val_dom, Val_net ONLY for use
1999  * by virterror wrappers.
2000  */
2001 static value
2002 Val_connect_no_finalize (virConnectPtr conn)
2003 {
2004   CAMLparam0 ();
2005   CAMLlocal1 (rv);
2006   rv = caml_alloc (1, Abstract_tag);
2007   Store_field (rv, 0, (value) conn);
2008   CAMLreturn (rv);
2009 }
2010
2011 static value
2012 Val_dom_no_finalize (virDomainPtr dom)
2013 {
2014   CAMLparam0 ();
2015   CAMLlocal1 (rv);
2016   rv = caml_alloc (1, Abstract_tag);
2017   Store_field (rv, 0, (value) dom);
2018   CAMLreturn (rv);
2019 }
2020
2021 static value
2022 Val_net_no_finalize (virNetworkPtr net)
2023 {
2024   CAMLparam0 ();
2025   CAMLlocal1 (rv);
2026   rv = caml_alloc (1, Abstract_tag);
2027   Store_field (rv, 0, (value) net);
2028   CAMLreturn (rv);
2029 }
2030
2031 /* This wraps up the (dom, conn) pair (Domain.t). */
2032 static value
2033 Val_domain (virDomainPtr dom, value connv)
2034 {
2035   CAMLparam1 (connv);
2036   CAMLlocal2 (rv, v);
2037
2038   rv = caml_alloc_tuple (2);
2039   v = Val_dom (dom);
2040   Store_field (rv, 0, v);
2041   Store_field (rv, 1, connv);
2042   CAMLreturn (rv);
2043 }
2044
2045 /* This wraps up the (net, conn) pair (Network.t). */
2046 static value
2047 Val_network (virNetworkPtr net, value connv)
2048 {
2049   CAMLparam1 (connv);
2050   CAMLlocal2 (rv, v);
2051
2052   rv = caml_alloc_tuple (2);
2053   v = Val_net (net);
2054   Store_field (rv, 0, v);
2055   Store_field (rv, 1, connv);
2056   CAMLreturn (rv);
2057 }
2058
2059 /* No-finalize versions of Val_domain, Val_network ONLY for use by
2060  * virterror wrappers.
2061  */
2062 static value
2063 Val_domain_no_finalize (virDomainPtr dom, value connv)
2064 {
2065   CAMLparam1 (connv);
2066   CAMLlocal2 (rv, v);
2067
2068   rv = caml_alloc_tuple (2);
2069   v = Val_dom_no_finalize (dom);
2070   Store_field (rv, 0, v);
2071   Store_field (rv, 1, connv);
2072   CAMLreturn (rv);
2073 }
2074
2075 static value
2076 Val_network_no_finalize (virNetworkPtr net, value connv)
2077 {
2078   CAMLparam1 (connv);
2079   CAMLlocal2 (rv, v);
2080
2081   rv = caml_alloc_tuple (2);
2082   v = Val_net_no_finalize (net);
2083   Store_field (rv, 0, v);
2084   Store_field (rv, 1, connv);
2085   CAMLreturn (rv);
2086 }
2087
2088 static void
2089 conn_finalize (value connv)
2090 {
2091   virConnectPtr conn = Connect_val (connv);
2092   if (conn) (void) virConnectClose (conn);
2093 }
2094
2095 static void
2096 dom_finalize (value domv)
2097 {
2098   virDomainPtr dom = Dom_val (domv);
2099   if (dom) (void) virDomainFree (dom);
2100 }
2101
2102 static void
2103 net_finalize (value netv)
2104 {
2105   virNetworkPtr net = Net_val (netv);
2106   if (net) (void) virNetworkFree (net);
2107 }