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