libvirt/libvirt_c_oneoffs.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 /* Please read libvirt/README file. */
  21
  22 #ifdef HAVE_WEAK_SYMBOLS
  23 #ifdef HAVE_VIRDOMAINBLOCKSTATS
  24 extern int virDomainBlockStats (virDomainPtr dom,
  25                                 const char *path,
  26                                 virDomainBlockStatsPtr stats,
  27                                 size_t size)
  28   __attribute__((weak));
  29 #endif
  30 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
  31 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
  32                                             virSchedParameterPtr params,
  33                                             int *nparams)
  34   __attribute__((weak));
  35 #endif
  36 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
  37 extern char *virDomainGetSchedulerType(virDomainPtr domain,
  38                                        int *nparams)
  39   __attribute__((weak));
  40 #endif
  41 #ifdef HAVE_VIRDOMAININTERFACESTATS
  42 extern int virDomainInterfaceStats (virDomainPtr dom,
  43                                     const char *path,
  44                                     virDomainInterfaceStatsPtr stats,
  45                                     size_t size)
  46   __attribute__((weak));
  47 #endif
  48 #ifdef HAVE_VIRDOMAINMIGRATE
  49 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
  50                                       unsigned long flags, const char *dname,
  51                                       const char *uri, unsigned long bandwidth)
  52   __attribute__((weak));
  53 #endif
  54 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
  55 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
  56                                             virSchedParameterPtr params,
  57                                             int nparams)
  58   __attribute__((weak));
  59 #endif
  60 #ifdef HAVE_VIRNODEGETFREEMEMORY
  61 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
  62   __attribute__((weak));
  63 #endif
  64 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
  65 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
  66                                       unsigned long long *freeMems,
  67                                       int startCell, int maxCells)
  68   __attribute__((weak));
  69 #endif
  70 #endif /* HAVE_WEAK_SYMBOLS */
  71
  72 /*----------------------------------------------------------------------*/
  73
  74 CAMLprim value
  75 ocaml_libvirt_get_version (value driverv, value unit)
  76 {
  77   CAMLparam2 (driverv, unit);
  78   CAMLlocal1 (rv);
  79   const char *driver = Optstring_val (driverv);
  80   unsigned long libVer, typeVer = 0, *typeVer_ptr;
  81   int r;
  82
  83   typeVer_ptr = driver ? &typeVer : NULL;
  84   NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
  85   CHECK_ERROR (r == -1, NULL, "virGetVersion");
  86
  87   rv = caml_alloc_tuple (2);
  88   Store_field (rv, 0, Val_int (libVer));
  89   Store_field (rv, 1, Val_int (typeVer));
  90   CAMLreturn (rv);
  91 }
  92
  93 /*----------------------------------------------------------------------*/
  94
  95 /* Connection object. */
  96
  97 CAMLprim value
  98 ocaml_libvirt_connect_open (value namev, value unit)
  99 {
 100   CAMLparam2 (namev, unit);
 101   CAMLlocal1 (rv);
 102   const char *name = Optstring_val (namev);
 103   virConnectPtr conn;
 104
 105   NONBLOCKING (conn = virConnectOpen (name));
 106   CHECK_ERROR (!conn, NULL, "virConnectOpen");
 107
 108   rv = Val_connect (conn);
 109
 110   CAMLreturn (rv);
 111 }
 112
 113 CAMLprim value
 114 ocaml_libvirt_connect_open_readonly (value namev, value unit)
 115 {
 116   CAMLparam2 (namev, unit);
 117   CAMLlocal1 (rv);
 118   const char *name = Optstring_val (namev);
 119   virConnectPtr conn;
 120
 121   NONBLOCKING (conn = virConnectOpenReadOnly (name));
 122   CHECK_ERROR (!conn, NULL, "virConnectOpen");
 123
 124   rv = Val_connect (conn);
 125
 126   CAMLreturn (rv);
 127 }
 128
 129 CAMLprim value
 130 ocaml_libvirt_connect_close (value connv)
 131 {
 132   CAMLparam1 (connv);
 133   virConnectPtr conn = Connect_val (connv);
 134   int r;
 135
 136   NONBLOCKING (r = virConnectClose (conn));
 137   CHECK_ERROR (r == -1, conn, "virConnectClose");
 138
 139   /* So that we don't double-free in the finalizer: */
 140   Connect_val (connv) = NULL;
 141
 142   CAMLreturn (Val_unit);
 143 }
 144
 145 CAMLprim value
 146 ocaml_libvirt_connect_get_version (value connv)
 147 {
 148   CAMLparam1 (connv);
 149   virConnectPtr conn = Connect_val (connv);
 150   unsigned long hvVer;
 151   int r;
 152
 153   NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
 154   CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
 155
 156   CAMLreturn (Val_int (hvVer));
 157 }
 158
 159 CAMLprim value
 160 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
 161 {
 162   CAMLparam2 (connv, typev);
 163   virConnectPtr conn = Connect_val (connv);
 164   const char *type = Optstring_val (typev);
 165   int r;
 166
 167   NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
 168   CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
 169
 170   CAMLreturn (Val_int (r));
 171 }
 172
 173 CAMLprim value
 174 ocaml_libvirt_connect_get_node_info (value connv)
 175 {
 176   CAMLparam1 (connv);
 177   CAMLlocal2 (rv, v);
 178   virConnectPtr conn = Connect_val (connv);
 179   virNodeInfo info;
 180   int r;
 181
 182   NONBLOCKING (r = virNodeGetInfo (conn, &info));
 183   CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
 184
 185   rv = caml_alloc (8, 0);
 186   v = caml_copy_string (info.model); Store_field (rv, 0, v);
 187   v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
 188   Store_field (rv, 2, Val_int (info.cpus));
 189   Store_field (rv, 3, Val_int (info.mhz));
 190   Store_field (rv, 4, Val_int (info.nodes));
 191   Store_field (rv, 5, Val_int (info.sockets));
 192   Store_field (rv, 6, Val_int (info.cores));
 193   Store_field (rv, 7, Val_int (info.threads));
 194
 195   CAMLreturn (rv);
 196 }
 197
 198 CAMLprim value
 199 ocaml_libvirt_connect_node_get_free_memory (value connv)
 200 {
 201 #ifdef HAVE_VIRNODEGETFREEMEMORY
 202   CAMLparam1 (connv);
 203   CAMLlocal1 (rv);
 204   virConnectPtr conn = Connect_val (connv);
 205   unsigned long long r;
 206
 207   WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
 208   NONBLOCKING (r = virNodeGetFreeMemory (conn));
 209   CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
 210
 211   rv = caml_copy_int64 ((int64) r);
 212   CAMLreturn (rv);
 213 #else
 214   not_supported ("virNodeGetFreeMemory");
 215 #endif
 216 }
 217
 218 CAMLprim value
 219 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
 220                                                   value startv, value maxv)
 221 {
 222 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
 223   CAMLparam3 (connv, startv, maxv);
 224   CAMLlocal2 (rv, iv);
 225   virConnectPtr conn = Connect_val (connv);
 226   int start = Int_val (startv);
 227   int max = Int_val (maxv);
 228   int r, i;
 229   unsigned long long freemems[max];
 230
 231   WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
 232   NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
 233   CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
 234
 235   rv = caml_alloc (r, 0);
 236   for (i = 0; i < r; ++i) {
 237     iv = caml_copy_int64 ((int64) freemems[i]);
 238     Store_field (rv, i, iv);
 239   }
 240
 241   CAMLreturn (rv);
 242 #else
 243   not_supported ("virNodeGetCellsFreeMemory");
 244 #endif
 245 }
 246
 247 CAMLprim value
 248 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
 249 {
 250   CAMLparam2 (connv, xmlv);
 251   CAMLlocal1 (rv);
 252   virConnectPtr conn = Connect_val (connv);
 253   char *xml = String_val (xmlv);
 254   virDomainPtr r;
 255
 256   NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0));
 257   CHECK_ERROR (!r, conn, "virDomainCreateLinux");
 258
 259   rv = Val_domain (r, connv);
 260   CAMLreturn (rv);
 261 }
 262
 263 CAMLprim value
 264 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
 265 {
 266   CAMLparam2 (connv, iv);
 267   CAMLlocal1 (rv);
 268   virConnectPtr conn = Connect_val (connv);
 269   int i = Int_val (iv);
 270   virDomainPtr r;
 271
 272   NONBLOCKING (r = virDomainLookupByID (conn, i));
 273   CHECK_ERROR (!r, conn, "virDomainLookupByID");
 274
 275   rv = Val_domain (r, connv);
 276   CAMLreturn (rv);
 277 }
 278
 279 CAMLprim value
 280 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
 281 {
 282   CAMLparam2 (connv, uuidv);
 283   CAMLlocal1 (rv);
 284   virConnectPtr conn = Connect_val (connv);
 285   char *uuid = String_val (uuidv);
 286   virDomainPtr r;
 287
 288   NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid));
 289   CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
 290
 291   rv = Val_domain (r, connv);
 292   CAMLreturn (rv);
 293 }
 294
 295 CAMLprim value
 296 ocaml_libvirt_domain_destroy (value domv)
 297 {
 298   CAMLparam1 (domv);
 299   virDomainPtr dom = Domain_val (domv);
 300   virConnectPtr conn = Connect_domv (domv);
 301   int r;
 302
 303   NONBLOCKING (r = virDomainDestroy (dom));
 304   CHECK_ERROR (r == -1, conn, "virDomainDestroy");
 305
 306   /* So that we don't double-free in the finalizer: */
 307   Domain_val (domv) = NULL;
 308
 309   CAMLreturn (Val_unit);
 310 }
 311
 312 CAMLprim value
 313 ocaml_libvirt_domain_free (value domv)
 314 {
 315   CAMLparam1 (domv);
 316   virDomainPtr dom = Domain_val (domv);
 317   virConnectPtr conn = Connect_domv (domv);
 318   int r;
 319
 320   NONBLOCKING (r = virDomainFree (dom));
 321   CHECK_ERROR (r == -1, conn, "virDomainFree");
 322
 323   /* So that we don't double-free in the finalizer: */
 324   Domain_val (domv) = NULL;
 325
 326   CAMLreturn (Val_unit);
 327 }
 328
 329 CAMLprim value
 330 ocaml_libvirt_domain_save (value domv, value pathv)
 331 {
 332   CAMLparam2 (domv, pathv);
 333   virDomainPtr dom = Domain_val (domv);
 334   virConnectPtr conn = Connect_domv (domv);
 335   char *path = String_val (pathv);
 336   int r;
 337
 338   NONBLOCKING (r = virDomainSave (dom, path));
 339   CHECK_ERROR (r == -1, conn, "virDomainSave");
 340
 341   CAMLreturn (Val_unit);
 342 }
 343
 344 CAMLprim value
 345 ocaml_libvirt_domain_restore (value connv, value pathv)
 346 {
 347   CAMLparam2 (connv, pathv);
 348   virConnectPtr conn = Connect_val (connv);
 349   char *path = String_val (pathv);
 350   int r;
 351
 352   NONBLOCKING (r = virDomainRestore (conn, path));
 353   CHECK_ERROR (r == -1, conn, "virDomainRestore");
 354
 355   CAMLreturn (Val_unit);
 356 }
 357
 358 CAMLprim value
 359 ocaml_libvirt_domain_core_dump (value domv, value pathv)
 360 {
 361   CAMLparam2 (domv, pathv);
 362   virDomainPtr dom = Domain_val (domv);
 363   virConnectPtr conn = Connect_domv (domv);
 364   char *path = String_val (pathv);
 365   int r;
 366
 367   NONBLOCKING (r = virDomainCoreDump (dom, path, 0));
 368   CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
 369
 370   CAMLreturn (Val_unit);
 371 }
 372
 373 CAMLprim value
 374 ocaml_libvirt_domain_get_uuid (value domv)
 375 {
 376   CAMLparam1 (domv);
 377   CAMLlocal1 (rv);
 378   virDomainPtr dom = Domain_val (domv);
 379   virConnectPtr conn = Connect_domv (domv);
 380   unsigned char uuid[VIR_UUID_BUFLEN];
 381   int r;
 382
 383   NONBLOCKING (r = virDomainGetUUID (dom, uuid));
 384   CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
 385
 386   rv = caml_copy_string ((char *) uuid);
 387   CAMLreturn (rv);
 388 }
 389
 390 CAMLprim value
 391 ocaml_libvirt_domain_get_uuid_string (value domv)
 392 {
 393   CAMLparam1 (domv);
 394   CAMLlocal1 (rv);
 395   virDomainPtr dom = Domain_val (domv);
 396   virConnectPtr conn = Connect_domv (domv);
 397   char uuid[VIR_UUID_STRING_BUFLEN];
 398   int r;
 399
 400   NONBLOCKING (r = virDomainGetUUIDString (dom, uuid));
 401   CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
 402
 403   rv = caml_copy_string (uuid);
 404   CAMLreturn (rv);
 405 }
 406
 407 CAMLprim value
 408 ocaml_libvirt_domain_get_id (value domv)
 409 {
 410   CAMLparam1 (domv);
 411   virDomainPtr dom = Domain_val (domv);
 412   virConnectPtr conn = Connect_domv (domv);
 413   unsigned int r;
 414
 415   NONBLOCKING (r = virDomainGetID (dom));
 416   /* There's a bug in libvirt which means that if you try to get
 417    * the ID of a defined-but-not-running domain, it returns -1,
 418    * and there's no way to distinguish that from an error.
 419    */
 420   CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
 421
 422   CAMLreturn (Val_int ((int) r));
 423 }
 424
 425 CAMLprim value
 426 ocaml_libvirt_domain_get_max_memory (value domv)
 427 {
 428   CAMLparam1 (domv);
 429   CAMLlocal1 (rv);
 430   virDomainPtr dom = Domain_val (domv);
 431   virConnectPtr conn = Connect_domv (domv);
 432   unsigned long r;
 433
 434   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 435   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 436
 437   rv = caml_copy_int64 (r);
 438   CAMLreturn (rv);
 439 }
 440
 441 CAMLprim value
 442 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 443 {
 444   CAMLparam2 (domv, memv);
 445   virDomainPtr dom = Domain_val (domv);
 446   virConnectPtr conn = Connect_domv (domv);
 447   unsigned long mem = Int64_val (memv);
 448   int r;
 449
 450   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 451   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 452
 453   CAMLreturn (Val_unit);
 454 }
 455
 456 CAMLprim value
 457 ocaml_libvirt_domain_set_memory (value domv, value memv)
 458 {
 459   CAMLparam2 (domv, memv);
 460   virDomainPtr dom = Domain_val (domv);
 461   virConnectPtr conn = Connect_domv (domv);
 462   unsigned long mem = Int64_val (memv);
 463   int r;
 464
 465   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 466   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 467
 468   CAMLreturn (Val_unit);
 469 }
 470
 471 CAMLprim value
 472 ocaml_libvirt_domain_get_info (value domv)
 473 {
 474   CAMLparam1 (domv);
 475   CAMLlocal2 (rv, v);
 476   virDomainPtr dom = Domain_val (domv);
 477   virConnectPtr conn = Connect_domv (domv);
 478   virDomainInfo info;
 479   int r;
 480
 481   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 482   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 483
 484   rv = caml_alloc (5, 0);
 485   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 486   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 487   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 488   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 489   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 490
 491   CAMLreturn (rv);
 492 }
 493
 494 CAMLprim value
 495 ocaml_libvirt_domain_get_scheduler_type (value domv)
 496 {
 497 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 498   CAMLparam1 (domv);
 499   CAMLlocal2 (rv, strv);
 500   virDomainPtr dom = Domain_val (domv);
 501   virConnectPtr conn = Connect_domv (domv);
 502   char *r;
 503   int nparams;
 504
 505   WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
 506   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
 507   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
 508
 509   rv = caml_alloc_tuple (2);
 510   strv = caml_copy_string (r); Store_field (rv, 0, strv);
 511   free (r);
 512   Store_field (rv, 1, nparams);
 513   CAMLreturn (rv);
 514 #else
 515   not_supported ("virDomainGetSchedulerType");
 516 #endif
 517 }
 518
 519 CAMLprim value
 520 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
 521 {
 522 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 523   CAMLparam2 (domv, nparamsv);
 524   CAMLlocal4 (rv, v, v2, v3);
 525   virDomainPtr dom = Domain_val (domv);
 526   virConnectPtr conn = Connect_domv (domv);
 527   int nparams = Int_val (nparamsv);
 528   virSchedParameter params[nparams];
 529   int r, i;
 530
 531   WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
 532   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
 533   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
 534
 535   rv = caml_alloc (nparams, 0);
 536   for (i = 0; i < nparams; ++i) {
 537     v = caml_alloc_tuple (2); Store_field (rv, i, v);
 538     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
 539     switch (params[i].type) {
 540     case VIR_DOMAIN_SCHED_FIELD_INT:
 541       v2 = caml_alloc (1, 0);
 542       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
 543       break;
 544     case VIR_DOMAIN_SCHED_FIELD_UINT:
 545       v2 = caml_alloc (1, 1);
 546       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
 547       break;
 548     case VIR_DOMAIN_SCHED_FIELD_LLONG:
 549       v2 = caml_alloc (1, 2);
 550       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
 551       break;
 552     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
 553       v2 = caml_alloc (1, 3);
 554       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
 555       break;
 556     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
 557       v2 = caml_alloc (1, 4);
 558       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
 559       break;
 560     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
 561       v2 = caml_alloc (1, 5);
 562       Store_field (v2, 0, Val_int (params[i].value.b));
 563       break;
 564     default:
 565       caml_failwith ((char *)__FUNCTION__);
 566     }
 567     Store_field (v, 1, v2);
 568   }
 569   CAMLreturn (rv);
 570 #else
 571   not_supported ("virDomainGetSchedulerParameters");
 572 #endif
 573 }
 574
 575 CAMLprim value
 576 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
 577 {
 578 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 579   CAMLparam2 (domv, paramsv);
 580   CAMLlocal1 (v);
 581   virDomainPtr dom = Domain_val (domv);
 582   virConnectPtr conn = Connect_domv (domv);
 583   int nparams = Wosize_val (paramsv);
 584   virSchedParameter params[nparams];
 585   int r, i;
 586   char *name;
 587
 588   for (i = 0; i < nparams; ++i) {
 589     v = Field (paramsv, i);     /* Points to the two-element tuple. */
 590     name = String_val (Field (v, 0));
 591     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
 592     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
 593     v = Field (v, 1);           /* Points to the sched_param_value block. */
 594     switch (Tag_val (v)) {
 595     case 0:
 596       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
 597       params[i].value.i = Int32_val (Field (v, 0));
 598       break;
 599     case 1:
 600       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
 601       params[i].value.ui = Int32_val (Field (v, 0));
 602       break;
 603     case 2:
 604       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
 605       params[i].value.l = Int64_val (Field (v, 0));
 606       break;
 607     case 3:
 608       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
 609       params[i].value.ul = Int64_val (Field (v, 0));
 610       break;
 611     case 4:
 612       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
 613       params[i].value.d = Double_val (Field (v, 0));
 614       break;
 615     case 5:
 616       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
 617       params[i].value.b = Int_val (Field (v, 0));
 618       break;
 619     default:
 620       caml_failwith ((char *)__FUNCTION__);
 621     }
 622   }
 623
 624   WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
 625   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
 626   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
 627
 628   CAMLreturn (Val_unit);
 629 #else
 630   not_supported ("virDomainSetSchedulerParameters");
 631 #endif
 632 }
 633
 634 CAMLprim value
 635 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
 636 {
 637   CAMLparam2 (connv, xmlv);
 638   CAMLlocal1 (rv);
 639   virConnectPtr conn = Connect_val (connv);
 640   char *xml = String_val (xmlv);
 641   virDomainPtr r;
 642
 643   NONBLOCKING (r = virDomainDefineXML (conn, xml));
 644   CHECK_ERROR (!r, conn, "virDomainDefineXML");
 645
 646   rv = Val_domain (r, connv);
 647   CAMLreturn (rv);
 648 }
 649
 650 CAMLprim value
 651 ocaml_libvirt_domain_get_autostart (value domv)
 652 {
 653   CAMLparam1 (domv);
 654   virDomainPtr dom = Domain_val (domv);
 655   virConnectPtr conn = Connect_domv (domv);
 656   int r, autostart;
 657
 658   NONBLOCKING (r = virDomainGetAutostart (dom, &autostart));
 659   CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
 660
 661   CAMLreturn (autostart ? Val_true : Val_false);
 662 }
 663
 664 CAMLprim value
 665 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
 666 {
 667   CAMLparam2 (domv, autostartv);
 668   virDomainPtr dom = Domain_val (domv);
 669   virConnectPtr conn = Connect_domv (domv);
 670   int r, autostart = autostartv == Val_true ? 1 : 0;
 671
 672   NONBLOCKING (r = virDomainSetAutostart (dom, autostart));
 673   CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
 674
 675   CAMLreturn (Val_unit);
 676 }
 677
 678 CAMLprim value
 679 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
 680 {
 681   CAMLparam2 (domv, nvcpusv);
 682   virDomainPtr dom = Domain_val (domv);
 683   virConnectPtr conn = Connect_domv (domv);
 684   int r, nvcpus = Int_val (nvcpusv);
 685
 686   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
 687   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
 688
 689   CAMLreturn (Val_unit);
 690 }
 691
 692 CAMLprim value
 693 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
 694 {
 695   CAMLparam3 (domv, vcpuv, cpumapv);
 696   virDomainPtr dom = Domain_val (domv);
 697   virConnectPtr conn = Connect_domv (domv);
 698   int maplen = caml_string_length (cpumapv);
 699   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
 700   int vcpu = Int_val (vcpuv);
 701   int r;
 702
 703   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
 704   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 705
 706   CAMLreturn (Val_unit);
 707 }
 708
 709 CAMLprim value
 710 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 711 {
 712   CAMLparam3 (domv, maxinfov, maplenv);
 713   CAMLlocal5 (rv, infov, strv, v, v2);
 714   virDomainPtr dom = Domain_val (domv);
 715   virConnectPtr conn = Connect_domv (domv);
 716   int maxinfo = Int_val (maxinfov);
 717   int maplen = Int_val (maplenv);
 718   virVcpuInfo info[maxinfo];
 719   unsigned char cpumaps[maxinfo * maplen];
 720   int r, i;
 721
 722   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
 723   memset (cpumaps, 0, maxinfo * maplen);
 724
 725   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
 726   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 727
 728   /* Copy the virVcpuInfo structures. */
 729   infov = caml_alloc (maxinfo, 0);
 730   for (i = 0; i < maxinfo; ++i) {
 731     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
 732     Store_field (v2, 0, Val_int (info[i].number));
 733     Store_field (v2, 1, Val_int (info[i].state));
 734     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
 735     Store_field (v2, 3, Val_int (info[i].cpu));
 736   }
 737
 738   /* Copy the bitmap. */
 739   strv = caml_alloc_string (maxinfo * maplen);
 740   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
 741
 742   /* Allocate the tuple and return it. */
 743   rv = caml_alloc_tuple (3);
 744   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
 745   Store_field (rv, 1, infov);
 746   Store_field (rv, 2, strv);
 747
 748   CAMLreturn (rv);
 749 }
 750
 751 CAMLprim value
 752 ocaml_libvirt_domain_get_max_vcpus (value domv)
 753 {
 754   CAMLparam1 (domv);
 755   virDomainPtr dom = Domain_val (domv);
 756   virConnectPtr conn = Connect_domv (domv);
 757   int r;
 758
 759   NONBLOCKING (r = virDomainGetMaxVcpus (dom));
 760   CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
 761
 762   CAMLreturn (Val_int (r));
 763 }
 764
 765 CAMLprim value
 766 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
 767 {
 768   CAMLparam2 (domv, xmlv);
 769   virDomainPtr dom = Domain_val (domv);
 770   virConnectPtr conn = Connect_domv (domv);
 771   char *xml = String_val (xmlv);
 772   int r;
 773
 774   NONBLOCKING (r = virDomainAttachDevice (dom, xml));
 775   CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
 776
 777   CAMLreturn (Val_unit);
 778 }
 779
 780 CAMLprim value
 781 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
 782 {
 783   CAMLparam2 (domv, xmlv);
 784   virDomainPtr dom = Domain_val (domv);
 785   virConnectPtr conn = Connect_domv (domv);
 786   char *xml = String_val (xmlv);
 787   int r;
 788
 789   NONBLOCKING (r = virDomainDetachDevice (dom, xml));
 790   CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
 791
 792   CAMLreturn (Val_unit);
 793 }
 794
 795 CAMLprim value
 796 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
 797 {
 798 #ifdef HAVE_VIRDOMAINMIGRATE
 799   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
 800   CAMLxparam2 (optbandwidthv, unitv);
 801   CAMLlocal2 (flagv, rv);
 802   virDomainPtr dom = Domain_val (domv);
 803   virConnectPtr conn = Connect_domv (domv);
 804   virConnectPtr dconn = Connect_val (dconnv);
 805   int flags = 0;
 806   const char *dname = Optstring_val (optdnamev);
 807   const char *uri = Optstring_val (opturiv);
 808   unsigned long bandwidth;
 809   virDomainPtr r;
 810
 811   /* Iterate over the list of flags. */
 812   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 813     {
 814       flagv = Field (flagsv, 0);
 815       if (flagv == Int_val(0))
 816         flags |= VIR_MIGRATE_LIVE;
 817     }
 818
 819   if (optbandwidthv == Val_int (0)) /* None */
 820     bandwidth = 0;
 821   else                          /* Some bandwidth */
 822     bandwidth = Int_val (Field (optbandwidthv, 0));
 823
 824   WEAK_SYMBOL_CHECK (virDomainMigrate);
 825   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
 826   CHECK_ERROR (!r, conn, "virDomainMigrate");
 827
 828   rv = Val_domain (r, dconnv);
 829
 830   CAMLreturn (rv);
 831
 832 #else /* virDomainMigrate not supported */
 833   not_supported ("virDomainMigrate");
 834 #endif
 835 }
 836
 837 CAMLprim value
 838 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
 839 {
 840   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
 841                                               argv[3], argv[4], argv[5],
 842                                               argv[6]);
 843 }
 844
 845 CAMLprim value
 846 ocaml_libvirt_domain_block_stats (value domv, value pathv)
 847 {
 848 #if HAVE_VIRDOMAINBLOCKSTATS
 849   CAMLparam2 (domv, pathv);
 850   CAMLlocal2 (rv,v);
 851   virDomainPtr dom = Domain_val (domv);
 852   virConnectPtr conn = Connect_domv (domv);
 853   char *path = String_val (pathv);
 854   struct _virDomainBlockStats stats;
 855   int r;
 856
 857   WEAK_SYMBOL_CHECK (virDomainBlockStats);
 858   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
 859   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
 860
 861   rv = caml_alloc (5, 0);
 862   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
 863   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
 864   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
 865   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
 866   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
 867
 868   CAMLreturn (rv);
 869 #else
 870   not_supported ("virDomainBlockStats");
 871 #endif
 872 }
 873
 874 CAMLprim value
 875 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 876 {
 877 #if HAVE_VIRDOMAININTERFACESTATS
 878   CAMLparam2 (domv, pathv);
 879   CAMLlocal2 (rv,v);
 880   virDomainPtr dom = Domain_val (domv);
 881   virConnectPtr conn = Connect_domv (domv);
 882   char *path = String_val (pathv);
 883   struct _virDomainInterfaceStats stats;
 884   int r;
 885
 886   WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
 887   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
 888   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
 889
 890   rv = caml_alloc (8, 0);
 891   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
 892   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
 893   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
 894   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
 895   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
 896   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
 897   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
 898   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
 899
 900   CAMLreturn (rv);
 901 #else
 902   not_supported ("virDomainInterfaceStats");
 903 #endif
 904 }
 905
 906 CAMLprim value
 907 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
 908 {
 909   CAMLparam2 (connv, uuidv);
 910   CAMLlocal1 (rv);
 911   virConnectPtr conn = Connect_val (connv);
 912   char *uuid = String_val (uuidv);
 913   virNetworkPtr r;
 914
 915   NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid));
 916   CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
 917
 918   rv = Val_network (r, connv);
 919   CAMLreturn (rv);
 920 }
 921
 922 CAMLprim value
 923 ocaml_libvirt_network_create_xml (value connv, value xmlv)
 924 {
 925   CAMLparam2 (connv, xmlv);
 926   CAMLlocal1 (rv);
 927   virConnectPtr conn = Connect_val (connv);
 928   char *xml = String_val (xmlv);
 929   virNetworkPtr r;
 930
 931   NONBLOCKING (r = virNetworkCreateXML (conn, xml));
 932   CHECK_ERROR (!r, conn, "virNetworkCreateXML");
 933
 934   rv = Val_network (r, connv);
 935   CAMLreturn (rv);
 936 }
 937
 938 CAMLprim value
 939 ocaml_libvirt_network_define_xml (value connv, value xmlv)
 940 {
 941   CAMLparam2 (connv, xmlv);
 942   CAMLlocal1 (rv);
 943   virConnectPtr conn = Connect_val (connv);
 944   char *xml = String_val (xmlv);
 945   virNetworkPtr r;
 946
 947   NONBLOCKING (r = virNetworkDefineXML (conn, xml));
 948   CHECK_ERROR (!r, conn, "virNetworkDefineXML");
 949
 950   rv = Val_network (r, connv);
 951   CAMLreturn (rv);
 952 }
 953
 954 CAMLprim value
 955 ocaml_libvirt_network_destroy (value netv)
 956 {
 957   CAMLparam1 (netv);
 958   virNetworkPtr net = Network_val (netv);
 959   virConnectPtr conn = Connect_netv (netv);
 960   int r;
 961
 962   NONBLOCKING (r = virNetworkDestroy (net));
 963   CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
 964
 965   /* So that we don't double-free in the finalizer: */
 966   Network_val (netv) = NULL;
 967
 968   CAMLreturn (Val_unit);
 969 }
 970
 971 CAMLprim value
 972 ocaml_libvirt_network_free (value netv)
 973 {
 974   CAMLparam1 (netv);
 975   virNetworkPtr net = Network_val (netv);
 976   virConnectPtr conn = Connect_netv (netv);
 977   int r;
 978
 979   NONBLOCKING (r = virNetworkFree (net));
 980   CHECK_ERROR (r == -1, conn, "virNetworkFree");
 981
 982   /* So that we don't double-free in the finalizer: */
 983   Network_val (netv) = NULL;
 984
 985   CAMLreturn (Val_unit);
 986 }
 987
 988 CAMLprim value
 989 ocaml_libvirt_network_get_uuid (value netv)
 990 {
 991   CAMLparam1 (netv);
 992   CAMLlocal1 (rv);
 993   virNetworkPtr net = Network_val (netv);
 994   virConnectPtr conn = Connect_netv (netv);
 995   unsigned char uuid[VIR_UUID_BUFLEN];
 996   int r;
 997
 998   NONBLOCKING (r = virNetworkGetUUID (net, uuid));
 999   CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1000
1001   rv = caml_copy_string ((char *) uuid);
1002   CAMLreturn (rv);
1003 }
1004
1005 CAMLprim value
1006 ocaml_libvirt_network_get_uuid_string (value netv)
1007 {
1008   CAMLparam1 (netv);
1009   CAMLlocal1 (rv);
1010   virNetworkPtr net = Network_val (netv);
1011   virConnectPtr conn = Connect_netv (netv);
1012   char uuid[VIR_UUID_STRING_BUFLEN];
1013   int r;
1014
1015   NONBLOCKING (r = virNetworkGetUUIDString (net, uuid));
1016   CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1017
1018   rv = caml_copy_string (uuid);
1019   CAMLreturn (rv);
1020 }
1021
1022 CAMLprim value
1023 ocaml_libvirt_network_get_autostart (value netv)
1024 {
1025   CAMLparam1 (netv);
1026   virNetworkPtr net = Network_val (netv);
1027   virConnectPtr conn = Connect_netv (netv);
1028   int r, autostart;
1029
1030   NONBLOCKING (r = virNetworkGetAutostart (net, &autostart));
1031   CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1032
1033   CAMLreturn (autostart ? Val_true : Val_false);
1034 }
1035
1036 CAMLprim value
1037 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1038 {
1039   CAMLparam2 (netv, autostartv);
1040   virNetworkPtr net = Network_val (netv);
1041   virConnectPtr conn = Connect_netv (netv);
1042   int r, autostart = autostartv == Val_true ? 1 : 0;
1043
1044   NONBLOCKING (r = virNetworkSetAutostart (net, autostart));
1045   CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1046
1047   CAMLreturn (Val_unit);
1048 }
1049
1050 /*----------------------------------------------------------------------*/
1051
1052 CAMLprim value
1053 ocaml_libvirt_virterror_get_last_error (value unitv)
1054 {
1055   CAMLparam1 (unitv);
1056   CAMLlocal1 (rv);
1057   virErrorPtr err = virGetLastError ();
1058
1059   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1060
1061   CAMLreturn (rv);
1062 }
1063
1064 CAMLprim value
1065 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1066 {
1067   CAMLparam1 (connv);
1068   CAMLlocal1 (rv);
1069   virConnectPtr conn = Connect_val (connv);
1070
1071   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1072
1073   CAMLreturn (rv);
1074 }
1075
1076 CAMLprim value
1077 ocaml_libvirt_virterror_reset_last_error (value unitv)
1078 {
1079   CAMLparam1 (unitv);
1080   virResetLastError ();
1081   CAMLreturn (Val_unit);
1082 }
1083
1084 CAMLprim value
1085 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1086 {
1087   CAMLparam1 (connv);
1088   virConnectPtr conn = Connect_val (connv);
1089   virConnResetLastError (conn);
1090   CAMLreturn (Val_unit);
1091 }
1092
1093 /*----------------------------------------------------------------------*/
1094
1095 /* Initialise the library. */
1096 CAMLprim value
1097 ocaml_libvirt_init (value unit)
1098 {
1099   CAMLparam1 (unit);
1100   CAMLlocal1 (rv);
1101   int r;
1102
1103   r = virInitialize ();
1104   CHECK_ERROR (r == -1, NULL, "virInitialize");
1105
1106   CAMLreturn (Val_unit);
1107 }