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