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_get_version (value connv)
 131 {
 132   CAMLparam1 (connv);
 133   virConnectPtr conn = Connect_val (connv);
 134   unsigned long hvVer;
 135   int r;
 136
 137   NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
 138   CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
 139
 140   CAMLreturn (Val_int (hvVer));
 141 }
 142
 143 CAMLprim value
 144 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
 145 {
 146   CAMLparam2 (connv, typev);
 147   virConnectPtr conn = Connect_val (connv);
 148   const char *type = Optstring_val (typev);
 149   int r;
 150
 151   NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
 152   CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
 153
 154   CAMLreturn (Val_int (r));
 155 }
 156
 157 CAMLprim value
 158 ocaml_libvirt_connect_get_node_info (value connv)
 159 {
 160   CAMLparam1 (connv);
 161   CAMLlocal2 (rv, v);
 162   virConnectPtr conn = Connect_val (connv);
 163   virNodeInfo info;
 164   int r;
 165
 166   NONBLOCKING (r = virNodeGetInfo (conn, &info));
 167   CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
 168
 169   rv = caml_alloc (8, 0);
 170   v = caml_copy_string (info.model); Store_field (rv, 0, v);
 171   v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
 172   Store_field (rv, 2, Val_int (info.cpus));
 173   Store_field (rv, 3, Val_int (info.mhz));
 174   Store_field (rv, 4, Val_int (info.nodes));
 175   Store_field (rv, 5, Val_int (info.sockets));
 176   Store_field (rv, 6, Val_int (info.cores));
 177   Store_field (rv, 7, Val_int (info.threads));
 178
 179   CAMLreturn (rv);
 180 }
 181
 182 CAMLprim value
 183 ocaml_libvirt_connect_node_get_free_memory (value connv)
 184 {
 185 #ifdef HAVE_VIRNODEGETFREEMEMORY
 186   CAMLparam1 (connv);
 187   CAMLlocal1 (rv);
 188   virConnectPtr conn = Connect_val (connv);
 189   unsigned long long r;
 190
 191   WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
 192   NONBLOCKING (r = virNodeGetFreeMemory (conn));
 193   CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
 194
 195   rv = caml_copy_int64 ((int64) r);
 196   CAMLreturn (rv);
 197 #else
 198   not_supported ("virNodeGetFreeMemory");
 199 #endif
 200 }
 201
 202 CAMLprim value
 203 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
 204                                                   value startv, value maxv)
 205 {
 206 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
 207   CAMLparam3 (connv, startv, maxv);
 208   CAMLlocal2 (rv, iv);
 209   virConnectPtr conn = Connect_val (connv);
 210   int start = Int_val (startv);
 211   int max = Int_val (maxv);
 212   int r, i;
 213   unsigned long long freemems[max];
 214
 215   WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
 216   NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
 217   CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
 218
 219   rv = caml_alloc (r, 0);
 220   for (i = 0; i < r; ++i) {
 221     iv = caml_copy_int64 ((int64) freemems[i]);
 222     Store_field (rv, i, iv);
 223   }
 224
 225   CAMLreturn (rv);
 226 #else
 227   not_supported ("virNodeGetCellsFreeMemory");
 228 #endif
 229 }
 230
 231 CAMLprim value
 232 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
 233 {
 234   CAMLparam2 (connv, xmlv);
 235   CAMLlocal1 (rv);
 236   virConnectPtr conn = Connect_val (connv);
 237   char *xml = String_val (xmlv);
 238   virDomainPtr r;
 239
 240   NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0));
 241   CHECK_ERROR (!r, conn, "virDomainCreateLinux");
 242
 243   rv = Val_domain (r, connv);
 244   CAMLreturn (rv);
 245 }
 246
 247 CAMLprim value
 248 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
 249 {
 250   CAMLparam2 (connv, iv);
 251   CAMLlocal1 (rv);
 252   virConnectPtr conn = Connect_val (connv);
 253   int i = Int_val (iv);
 254   virDomainPtr r;
 255
 256   NONBLOCKING (r = virDomainLookupByID (conn, i));
 257   CHECK_ERROR (!r, conn, "virDomainLookupByID");
 258
 259   rv = Val_domain (r, connv);
 260   CAMLreturn (rv);
 261 }
 262
 263 CAMLprim value
 264 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
 265 {
 266   CAMLparam2 (connv, uuidv);
 267   CAMLlocal1 (rv);
 268   virConnectPtr conn = Connect_val (connv);
 269   char *uuid = String_val (uuidv);
 270   virDomainPtr r;
 271
 272   NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid));
 273   CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
 274
 275   rv = Val_domain (r, connv);
 276   CAMLreturn (rv);
 277 }
 278
 279 CAMLprim value
 280 ocaml_libvirt_domain_save (value domv, value pathv)
 281 {
 282   CAMLparam2 (domv, pathv);
 283   virDomainPtr dom = Domain_val (domv);
 284   virConnectPtr conn = Connect_domv (domv);
 285   char *path = String_val (pathv);
 286   int r;
 287
 288   NONBLOCKING (r = virDomainSave (dom, path));
 289   CHECK_ERROR (r == -1, conn, "virDomainSave");
 290
 291   CAMLreturn (Val_unit);
 292 }
 293
 294 CAMLprim value
 295 ocaml_libvirt_domain_restore (value connv, value pathv)
 296 {
 297   CAMLparam2 (connv, pathv);
 298   virConnectPtr conn = Connect_val (connv);
 299   char *path = String_val (pathv);
 300   int r;
 301
 302   NONBLOCKING (r = virDomainRestore (conn, path));
 303   CHECK_ERROR (r == -1, conn, "virDomainRestore");
 304
 305   CAMLreturn (Val_unit);
 306 }
 307
 308 CAMLprim value
 309 ocaml_libvirt_domain_core_dump (value domv, value pathv)
 310 {
 311   CAMLparam2 (domv, pathv);
 312   virDomainPtr dom = Domain_val (domv);
 313   virConnectPtr conn = Connect_domv (domv);
 314   char *path = String_val (pathv);
 315   int r;
 316
 317   NONBLOCKING (r = virDomainCoreDump (dom, path, 0));
 318   CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
 319
 320   CAMLreturn (Val_unit);
 321 }
 322
 323 CAMLprim value
 324 ocaml_libvirt_domain_get_id (value domv)
 325 {
 326   CAMLparam1 (domv);
 327   virDomainPtr dom = Domain_val (domv);
 328   virConnectPtr conn = Connect_domv (domv);
 329   unsigned int r;
 330
 331   NONBLOCKING (r = virDomainGetID (dom));
 332   /* There's a bug in libvirt which means that if you try to get
 333    * the ID of a defined-but-not-running domain, it returns -1,
 334    * and there's no way to distinguish that from an error.
 335    */
 336   CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
 337
 338   CAMLreturn (Val_int ((int) r));
 339 }
 340
 341 CAMLprim value
 342 ocaml_libvirt_domain_get_max_memory (value domv)
 343 {
 344   CAMLparam1 (domv);
 345   CAMLlocal1 (rv);
 346   virDomainPtr dom = Domain_val (domv);
 347   virConnectPtr conn = Connect_domv (domv);
 348   unsigned long r;
 349
 350   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 351   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 352
 353   rv = caml_copy_int64 (r);
 354   CAMLreturn (rv);
 355 }
 356
 357 CAMLprim value
 358 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 359 {
 360   CAMLparam2 (domv, memv);
 361   virDomainPtr dom = Domain_val (domv);
 362   virConnectPtr conn = Connect_domv (domv);
 363   unsigned long mem = Int64_val (memv);
 364   int r;
 365
 366   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 367   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 368
 369   CAMLreturn (Val_unit);
 370 }
 371
 372 CAMLprim value
 373 ocaml_libvirt_domain_set_memory (value domv, value memv)
 374 {
 375   CAMLparam2 (domv, memv);
 376   virDomainPtr dom = Domain_val (domv);
 377   virConnectPtr conn = Connect_domv (domv);
 378   unsigned long mem = Int64_val (memv);
 379   int r;
 380
 381   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 382   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 383
 384   CAMLreturn (Val_unit);
 385 }
 386
 387 CAMLprim value
 388 ocaml_libvirt_domain_get_info (value domv)
 389 {
 390   CAMLparam1 (domv);
 391   CAMLlocal2 (rv, v);
 392   virDomainPtr dom = Domain_val (domv);
 393   virConnectPtr conn = Connect_domv (domv);
 394   virDomainInfo info;
 395   int r;
 396
 397   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 398   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 399
 400   rv = caml_alloc (5, 0);
 401   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 402   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 403   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 404   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 405   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 406
 407   CAMLreturn (rv);
 408 }
 409
 410 CAMLprim value
 411 ocaml_libvirt_domain_get_scheduler_type (value domv)
 412 {
 413 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 414   CAMLparam1 (domv);
 415   CAMLlocal2 (rv, strv);
 416   virDomainPtr dom = Domain_val (domv);
 417   virConnectPtr conn = Connect_domv (domv);
 418   char *r;
 419   int nparams;
 420
 421   WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
 422   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
 423   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
 424
 425   rv = caml_alloc_tuple (2);
 426   strv = caml_copy_string (r); Store_field (rv, 0, strv);
 427   free (r);
 428   Store_field (rv, 1, nparams);
 429   CAMLreturn (rv);
 430 #else
 431   not_supported ("virDomainGetSchedulerType");
 432 #endif
 433 }
 434
 435 CAMLprim value
 436 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
 437 {
 438 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 439   CAMLparam2 (domv, nparamsv);
 440   CAMLlocal4 (rv, v, v2, v3);
 441   virDomainPtr dom = Domain_val (domv);
 442   virConnectPtr conn = Connect_domv (domv);
 443   int nparams = Int_val (nparamsv);
 444   virSchedParameter params[nparams];
 445   int r, i;
 446
 447   WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
 448   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
 449   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
 450
 451   rv = caml_alloc (nparams, 0);
 452   for (i = 0; i < nparams; ++i) {
 453     v = caml_alloc_tuple (2); Store_field (rv, i, v);
 454     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
 455     switch (params[i].type) {
 456     case VIR_DOMAIN_SCHED_FIELD_INT:
 457       v2 = caml_alloc (1, 0);
 458       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
 459       break;
 460     case VIR_DOMAIN_SCHED_FIELD_UINT:
 461       v2 = caml_alloc (1, 1);
 462       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
 463       break;
 464     case VIR_DOMAIN_SCHED_FIELD_LLONG:
 465       v2 = caml_alloc (1, 2);
 466       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
 467       break;
 468     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
 469       v2 = caml_alloc (1, 3);
 470       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
 471       break;
 472     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
 473       v2 = caml_alloc (1, 4);
 474       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
 475       break;
 476     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
 477       v2 = caml_alloc (1, 5);
 478       Store_field (v2, 0, Val_int (params[i].value.b));
 479       break;
 480     default:
 481       caml_failwith ((char *)__FUNCTION__);
 482     }
 483     Store_field (v, 1, v2);
 484   }
 485   CAMLreturn (rv);
 486 #else
 487   not_supported ("virDomainGetSchedulerParameters");
 488 #endif
 489 }
 490
 491 CAMLprim value
 492 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
 493 {
 494 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 495   CAMLparam2 (domv, paramsv);
 496   CAMLlocal1 (v);
 497   virDomainPtr dom = Domain_val (domv);
 498   virConnectPtr conn = Connect_domv (domv);
 499   int nparams = Wosize_val (paramsv);
 500   virSchedParameter params[nparams];
 501   int r, i;
 502   char *name;
 503
 504   for (i = 0; i < nparams; ++i) {
 505     v = Field (paramsv, i);     /* Points to the two-element tuple. */
 506     name = String_val (Field (v, 0));
 507     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
 508     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
 509     v = Field (v, 1);           /* Points to the sched_param_value block. */
 510     switch (Tag_val (v)) {
 511     case 0:
 512       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
 513       params[i].value.i = Int32_val (Field (v, 0));
 514       break;
 515     case 1:
 516       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
 517       params[i].value.ui = Int32_val (Field (v, 0));
 518       break;
 519     case 2:
 520       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
 521       params[i].value.l = Int64_val (Field (v, 0));
 522       break;
 523     case 3:
 524       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
 525       params[i].value.ul = Int64_val (Field (v, 0));
 526       break;
 527     case 4:
 528       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
 529       params[i].value.d = Double_val (Field (v, 0));
 530       break;
 531     case 5:
 532       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
 533       params[i].value.b = Int_val (Field (v, 0));
 534       break;
 535     default:
 536       caml_failwith ((char *)__FUNCTION__);
 537     }
 538   }
 539
 540   WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
 541   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
 542   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
 543
 544   CAMLreturn (Val_unit);
 545 #else
 546   not_supported ("virDomainSetSchedulerParameters");
 547 #endif
 548 }
 549
 550 CAMLprim value
 551 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
 552 {
 553   CAMLparam2 (connv, xmlv);
 554   CAMLlocal1 (rv);
 555   virConnectPtr conn = Connect_val (connv);
 556   char *xml = String_val (xmlv);
 557   virDomainPtr r;
 558
 559   NONBLOCKING (r = virDomainDefineXML (conn, xml));
 560   CHECK_ERROR (!r, conn, "virDomainDefineXML");
 561
 562   rv = Val_domain (r, connv);
 563   CAMLreturn (rv);
 564 }
 565
 566 CAMLprim value
 567 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
 568 {
 569   CAMLparam2 (domv, nvcpusv);
 570   virDomainPtr dom = Domain_val (domv);
 571   virConnectPtr conn = Connect_domv (domv);
 572   int r, nvcpus = Int_val (nvcpusv);
 573
 574   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
 575   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
 576
 577   CAMLreturn (Val_unit);
 578 }
 579
 580 CAMLprim value
 581 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
 582 {
 583   CAMLparam3 (domv, vcpuv, cpumapv);
 584   virDomainPtr dom = Domain_val (domv);
 585   virConnectPtr conn = Connect_domv (domv);
 586   int maplen = caml_string_length (cpumapv);
 587   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
 588   int vcpu = Int_val (vcpuv);
 589   int r;
 590
 591   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
 592   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 593
 594   CAMLreturn (Val_unit);
 595 }
 596
 597 CAMLprim value
 598 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 599 {
 600   CAMLparam3 (domv, maxinfov, maplenv);
 601   CAMLlocal5 (rv, infov, strv, v, v2);
 602   virDomainPtr dom = Domain_val (domv);
 603   virConnectPtr conn = Connect_domv (domv);
 604   int maxinfo = Int_val (maxinfov);
 605   int maplen = Int_val (maplenv);
 606   virVcpuInfo info[maxinfo];
 607   unsigned char cpumaps[maxinfo * maplen];
 608   int r, i;
 609
 610   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
 611   memset (cpumaps, 0, maxinfo * maplen);
 612
 613   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
 614   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 615
 616   /* Copy the virVcpuInfo structures. */
 617   infov = caml_alloc (maxinfo, 0);
 618   for (i = 0; i < maxinfo; ++i) {
 619     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
 620     Store_field (v2, 0, Val_int (info[i].number));
 621     Store_field (v2, 1, Val_int (info[i].state));
 622     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
 623     Store_field (v2, 3, Val_int (info[i].cpu));
 624   }
 625
 626   /* Copy the bitmap. */
 627   strv = caml_alloc_string (maxinfo * maplen);
 628   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
 629
 630   /* Allocate the tuple and return it. */
 631   rv = caml_alloc_tuple (3);
 632   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
 633   Store_field (rv, 1, infov);
 634   Store_field (rv, 2, strv);
 635
 636   CAMLreturn (rv);
 637 }
 638
 639 CAMLprim value
 640 ocaml_libvirt_domain_get_max_vcpus (value domv)
 641 {
 642   CAMLparam1 (domv);
 643   virDomainPtr dom = Domain_val (domv);
 644   virConnectPtr conn = Connect_domv (domv);
 645   int r;
 646
 647   NONBLOCKING (r = virDomainGetMaxVcpus (dom));
 648   CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
 649
 650   CAMLreturn (Val_int (r));
 651 }
 652
 653 CAMLprim value
 654 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
 655 {
 656   CAMLparam2 (domv, xmlv);
 657   virDomainPtr dom = Domain_val (domv);
 658   virConnectPtr conn = Connect_domv (domv);
 659   char *xml = String_val (xmlv);
 660   int r;
 661
 662   NONBLOCKING (r = virDomainAttachDevice (dom, xml));
 663   CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
 664
 665   CAMLreturn (Val_unit);
 666 }
 667
 668 CAMLprim value
 669 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
 670 {
 671   CAMLparam2 (domv, xmlv);
 672   virDomainPtr dom = Domain_val (domv);
 673   virConnectPtr conn = Connect_domv (domv);
 674   char *xml = String_val (xmlv);
 675   int r;
 676
 677   NONBLOCKING (r = virDomainDetachDevice (dom, xml));
 678   CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
 679
 680   CAMLreturn (Val_unit);
 681 }
 682
 683 CAMLprim value
 684 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
 685 {
 686 #ifdef HAVE_VIRDOMAINMIGRATE
 687   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
 688   CAMLxparam2 (optbandwidthv, unitv);
 689   CAMLlocal2 (flagv, rv);
 690   virDomainPtr dom = Domain_val (domv);
 691   virConnectPtr conn = Connect_domv (domv);
 692   virConnectPtr dconn = Connect_val (dconnv);
 693   int flags = 0;
 694   const char *dname = Optstring_val (optdnamev);
 695   const char *uri = Optstring_val (opturiv);
 696   unsigned long bandwidth;
 697   virDomainPtr r;
 698
 699   /* Iterate over the list of flags. */
 700   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 701     {
 702       flagv = Field (flagsv, 0);
 703       if (flagv == Int_val(0))
 704         flags |= VIR_MIGRATE_LIVE;
 705     }
 706
 707   if (optbandwidthv == Val_int (0)) /* None */
 708     bandwidth = 0;
 709   else                          /* Some bandwidth */
 710     bandwidth = Int_val (Field (optbandwidthv, 0));
 711
 712   WEAK_SYMBOL_CHECK (virDomainMigrate);
 713   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
 714   CHECK_ERROR (!r, conn, "virDomainMigrate");
 715
 716   rv = Val_domain (r, dconnv);
 717
 718   CAMLreturn (rv);
 719
 720 #else /* virDomainMigrate not supported */
 721   not_supported ("virDomainMigrate");
 722 #endif
 723 }
 724
 725 CAMLprim value
 726 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
 727 {
 728   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
 729                                               argv[3], argv[4], argv[5],
 730                                               argv[6]);
 731 }
 732
 733 CAMLprim value
 734 ocaml_libvirt_domain_block_stats (value domv, value pathv)
 735 {
 736 #if HAVE_VIRDOMAINBLOCKSTATS
 737   CAMLparam2 (domv, pathv);
 738   CAMLlocal2 (rv,v);
 739   virDomainPtr dom = Domain_val (domv);
 740   virConnectPtr conn = Connect_domv (domv);
 741   char *path = String_val (pathv);
 742   struct _virDomainBlockStats stats;
 743   int r;
 744
 745   WEAK_SYMBOL_CHECK (virDomainBlockStats);
 746   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
 747   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
 748
 749   rv = caml_alloc (5, 0);
 750   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
 751   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
 752   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
 753   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
 754   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
 755
 756   CAMLreturn (rv);
 757 #else
 758   not_supported ("virDomainBlockStats");
 759 #endif
 760 }
 761
 762 CAMLprim value
 763 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 764 {
 765 #if HAVE_VIRDOMAININTERFACESTATS
 766   CAMLparam2 (domv, pathv);
 767   CAMLlocal2 (rv,v);
 768   virDomainPtr dom = Domain_val (domv);
 769   virConnectPtr conn = Connect_domv (domv);
 770   char *path = String_val (pathv);
 771   struct _virDomainInterfaceStats stats;
 772   int r;
 773
 774   WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
 775   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
 776   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
 777
 778   rv = caml_alloc (8, 0);
 779   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
 780   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
 781   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
 782   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
 783   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
 784   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
 785   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
 786   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
 787
 788   CAMLreturn (rv);
 789 #else
 790   not_supported ("virDomainInterfaceStats");
 791 #endif
 792 }
 793
 794 CAMLprim value
 795 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
 796 {
 797   CAMLparam2 (connv, uuidv);
 798   CAMLlocal1 (rv);
 799   virConnectPtr conn = Connect_val (connv);
 800   char *uuid = String_val (uuidv);
 801   virNetworkPtr r;
 802
 803   NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid));
 804   CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
 805
 806   rv = Val_network (r, connv);
 807   CAMLreturn (rv);
 808 }
 809
 810 CAMLprim value
 811 ocaml_libvirt_network_create_xml (value connv, value xmlv)
 812 {
 813   CAMLparam2 (connv, xmlv);
 814   CAMLlocal1 (rv);
 815   virConnectPtr conn = Connect_val (connv);
 816   char *xml = String_val (xmlv);
 817   virNetworkPtr r;
 818
 819   NONBLOCKING (r = virNetworkCreateXML (conn, xml));
 820   CHECK_ERROR (!r, conn, "virNetworkCreateXML");
 821
 822   rv = Val_network (r, connv);
 823   CAMLreturn (rv);
 824 }
 825
 826 CAMLprim value
 827 ocaml_libvirt_network_define_xml (value connv, value xmlv)
 828 {
 829   CAMLparam2 (connv, xmlv);
 830   CAMLlocal1 (rv);
 831   virConnectPtr conn = Connect_val (connv);
 832   char *xml = String_val (xmlv);
 833   virNetworkPtr r;
 834
 835   NONBLOCKING (r = virNetworkDefineXML (conn, xml));
 836   CHECK_ERROR (!r, conn, "virNetworkDefineXML");
 837
 838   rv = Val_network (r, connv);
 839   CAMLreturn (rv);
 840 }
 841
 842 /*----------------------------------------------------------------------*/
 843
 844 CAMLprim value
 845 ocaml_libvirt_virterror_get_last_error (value unitv)
 846 {
 847   CAMLparam1 (unitv);
 848   CAMLlocal1 (rv);
 849   virErrorPtr err = virGetLastError ();
 850
 851   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
 852
 853   CAMLreturn (rv);
 854 }
 855
 856 CAMLprim value
 857 ocaml_libvirt_virterror_get_last_conn_error (value connv)
 858 {
 859   CAMLparam1 (connv);
 860   CAMLlocal1 (rv);
 861   virConnectPtr conn = Connect_val (connv);
 862
 863   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
 864
 865   CAMLreturn (rv);
 866 }
 867
 868 CAMLprim value
 869 ocaml_libvirt_virterror_reset_last_error (value unitv)
 870 {
 871   CAMLparam1 (unitv);
 872   virResetLastError ();
 873   CAMLreturn (Val_unit);
 874 }
 875
 876 CAMLprim value
 877 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
 878 {
 879   CAMLparam1 (connv);
 880   virConnectPtr conn = Connect_val (connv);
 881   virConnResetLastError (conn);
 882   CAMLreturn (Val_unit);
 883 }
 884
 885 /*----------------------------------------------------------------------*/
 886
 887 /* Initialise the library. */
 888 CAMLprim value
 889 ocaml_libvirt_init (value unit)
 890 {
 891   CAMLparam1 (unit);
 892   CAMLlocal1 (rv);
 893   int r;
 894
 895   r = virInitialize ();
 896   CHECK_ERROR (r == -1, NULL, "virInitialize");
 897
 898   CAMLreturn (Val_unit);
 899 }