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