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   /* There's a bug in libvirt which means that if you try to get
 292    * the ID of a defined-but-not-running domain, it returns -1,
 293    * and there's no way to distinguish that from an error.
 294    */
 295   CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
 296
 297   CAMLreturn (Val_int ((int) r));
 298 }
 299
 300 CAMLprim value
 301 ocaml_libvirt_domain_get_max_memory (value domv)
 302 {
 303   CAMLparam1 (domv);
 304   CAMLlocal1 (rv);
 305   virDomainPtr dom = Domain_val (domv);
 306   virConnectPtr conn = Connect_domv (domv);
 307   unsigned long r;
 308
 309   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 310   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 311
 312   rv = caml_copy_int64 (r);
 313   CAMLreturn (rv);
 314 }
 315
 316 CAMLprim value
 317 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 318 {
 319   CAMLparam2 (domv, memv);
 320   virDomainPtr dom = Domain_val (domv);
 321   virConnectPtr conn = Connect_domv (domv);
 322   unsigned long mem = Int64_val (memv);
 323   int r;
 324
 325   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 326   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 327
 328   CAMLreturn (Val_unit);
 329 }
 330
 331 CAMLprim value
 332 ocaml_libvirt_domain_set_memory (value domv, value memv)
 333 {
 334   CAMLparam2 (domv, memv);
 335   virDomainPtr dom = Domain_val (domv);
 336   virConnectPtr conn = Connect_domv (domv);
 337   unsigned long mem = Int64_val (memv);
 338   int r;
 339
 340   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 341   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 342
 343   CAMLreturn (Val_unit);
 344 }
 345
 346 CAMLprim value
 347 ocaml_libvirt_domain_get_info (value domv)
 348 {
 349   CAMLparam1 (domv);
 350   CAMLlocal2 (rv, v);
 351   virDomainPtr dom = Domain_val (domv);
 352   virConnectPtr conn = Connect_domv (domv);
 353   virDomainInfo info;
 354   int r;
 355
 356   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 357   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 358
 359   rv = caml_alloc (5, 0);
 360   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 361   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 362   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 363   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 364   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 365
 366   CAMLreturn (rv);
 367 }
 368
 369 #ifdef HAVE_WEAK_SYMBOLS
 370 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 371 extern char *virDomainGetSchedulerType(virDomainPtr domain,
 372                                        int *nparams)
 373   __attribute__((weak));
 374 #endif
 375 #endif
 376
 377 CAMLprim value
 378 ocaml_libvirt_domain_get_scheduler_type (value domv)
 379 {
 380 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 381   CAMLparam1 (domv);
 382   CAMLlocal2 (rv, strv);
 383   virDomainPtr dom = Domain_val (domv);
 384   virConnectPtr conn = Connect_domv (domv);
 385   char *r;
 386   int nparams;
 387
 388   WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
 389   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
 390   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
 391
 392   rv = caml_alloc_tuple (2);
 393   strv = caml_copy_string (r); Store_field (rv, 0, strv);
 394   free (r);
 395   Store_field (rv, 1, nparams);
 396   CAMLreturn (rv);
 397 #else
 398   not_supported ("virDomainGetSchedulerType");
 399 #endif
 400 }
 401
 402 #ifdef HAVE_WEAK_SYMBOLS
 403 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 404 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
 405                                             virSchedParameterPtr params,
 406                                             int *nparams)
 407   __attribute__((weak));
 408 #endif
 409 #endif
 410
 411 CAMLprim value
 412 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
 413 {
 414 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 415   CAMLparam2 (domv, nparamsv);
 416   CAMLlocal4 (rv, v, v2, v3);
 417   virDomainPtr dom = Domain_val (domv);
 418   virConnectPtr conn = Connect_domv (domv);
 419   int nparams = Int_val (nparamsv);
 420   virSchedParameter params[nparams];
 421   int r, i;
 422
 423   WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
 424   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
 425   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
 426
 427   rv = caml_alloc (nparams, 0);
 428   for (i = 0; i < nparams; ++i) {
 429     v = caml_alloc_tuple (2); Store_field (rv, i, v);
 430     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
 431     switch (params[i].type) {
 432     case VIR_DOMAIN_SCHED_FIELD_INT:
 433       v2 = caml_alloc (1, 0);
 434       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
 435       break;
 436     case VIR_DOMAIN_SCHED_FIELD_UINT:
 437       v2 = caml_alloc (1, 1);
 438       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
 439       break;
 440     case VIR_DOMAIN_SCHED_FIELD_LLONG:
 441       v2 = caml_alloc (1, 2);
 442       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
 443       break;
 444     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
 445       v2 = caml_alloc (1, 3);
 446       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
 447       break;
 448     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
 449       v2 = caml_alloc (1, 4);
 450       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
 451       break;
 452     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
 453       v2 = caml_alloc (1, 5);
 454       Store_field (v2, 0, Val_int (params[i].value.b));
 455       break;
 456     default:
 457       caml_failwith ((char *)__FUNCTION__);
 458     }
 459     Store_field (v, 1, v2);
 460   }
 461   CAMLreturn (rv);
 462 #else
 463   not_supported ("virDomainGetSchedulerParameters");
 464 #endif
 465 }
 466
 467 #ifdef HAVE_WEAK_SYMBOLS
 468 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 469 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
 470                                             virSchedParameterPtr params,
 471                                             int nparams)
 472   __attribute__((weak));
 473 #endif
 474 #endif
 475
 476 CAMLprim value
 477 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
 478 {
 479 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 480   CAMLparam2 (domv, paramsv);
 481   CAMLlocal1 (v);
 482   virDomainPtr dom = Domain_val (domv);
 483   virConnectPtr conn = Connect_domv (domv);
 484   int nparams = Wosize_val (paramsv);
 485   virSchedParameter params[nparams];
 486   int r, i;
 487   char *name;
 488
 489   for (i = 0; i < nparams; ++i) {
 490     v = Field (paramsv, i);     /* Points to the two-element tuple. */
 491     name = String_val (Field (v, 0));
 492     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
 493     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
 494     v = Field (v, 1);           /* Points to the sched_param_value block. */
 495     switch (Tag_val (v)) {
 496     case 0:
 497       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
 498       params[i].value.i = Int32_val (Field (v, 0));
 499       break;
 500     case 1:
 501       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
 502       params[i].value.ui = Int32_val (Field (v, 0));
 503       break;
 504     case 2:
 505       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
 506       params[i].value.l = Int64_val (Field (v, 0));
 507       break;
 508     case 3:
 509       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
 510       params[i].value.ul = Int64_val (Field (v, 0));
 511       break;
 512     case 4:
 513       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
 514       params[i].value.d = Double_val (Field (v, 0));
 515       break;
 516     case 5:
 517       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
 518       params[i].value.b = Int_val (Field (v, 0));
 519       break;
 520     default:
 521       caml_failwith ((char *)__FUNCTION__);
 522     }
 523   }
 524
 525   WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
 526   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
 527   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
 528
 529   CAMLreturn (Val_unit);
 530 #else
 531   not_supported ("virDomainSetSchedulerParameters");
 532 #endif
 533 }
 534
 535 CAMLprim value
 536 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
 537 {
 538   CAMLparam2 (domv, nvcpusv);
 539   virDomainPtr dom = Domain_val (domv);
 540   virConnectPtr conn = Connect_domv (domv);
 541   int r, nvcpus = Int_val (nvcpusv);
 542
 543   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
 544   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
 545
 546   CAMLreturn (Val_unit);
 547 }
 548
 549 CAMLprim value
 550 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
 551 {
 552   CAMLparam3 (domv, vcpuv, cpumapv);
 553   virDomainPtr dom = Domain_val (domv);
 554   virConnectPtr conn = Connect_domv (domv);
 555   int maplen = caml_string_length (cpumapv);
 556   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
 557   int vcpu = Int_val (vcpuv);
 558   int r;
 559
 560   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
 561   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 562
 563   CAMLreturn (Val_unit);
 564 }
 565
 566 CAMLprim value
 567 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 568 {
 569   CAMLparam3 (domv, maxinfov, maplenv);
 570   CAMLlocal5 (rv, infov, strv, v, v2);
 571   virDomainPtr dom = Domain_val (domv);
 572   virConnectPtr conn = Connect_domv (domv);
 573   int maxinfo = Int_val (maxinfov);
 574   int maplen = Int_val (maplenv);
 575   virVcpuInfo info[maxinfo];
 576   unsigned char cpumaps[maxinfo * maplen];
 577   int r, i;
 578
 579   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
 580   memset (cpumaps, 0, maxinfo * maplen);
 581
 582   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
 583   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 584
 585   /* Copy the virVcpuInfo structures. */
 586   infov = caml_alloc (maxinfo, 0);
 587   for (i = 0; i < maxinfo; ++i) {
 588     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
 589     Store_field (v2, 0, Val_int (info[i].number));
 590     Store_field (v2, 1, Val_int (info[i].state));
 591     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
 592     Store_field (v2, 3, Val_int (info[i].cpu));
 593   }
 594
 595   /* Copy the bitmap. */
 596   strv = caml_alloc_string (maxinfo * maplen);
 597   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
 598
 599   /* Allocate the tuple and return it. */
 600   rv = caml_alloc_tuple (3);
 601   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
 602   Store_field (rv, 1, infov);
 603   Store_field (rv, 2, strv);
 604
 605   CAMLreturn (rv);
 606 }
 607
 608 #ifdef HAVE_WEAK_SYMBOLS
 609 #ifdef HAVE_VIRDOMAINMIGRATE
 610 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
 611                                       unsigned long flags, const char *dname,
 612                                       const char *uri, unsigned long bandwidth)
 613   __attribute__((weak));
 614 #endif
 615 #endif
 616
 617 CAMLprim value
 618 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
 619 {
 620 #ifdef HAVE_VIRDOMAINMIGRATE
 621   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
 622   CAMLxparam2 (optbandwidthv, unitv);
 623   CAMLlocal2 (flagv, rv);
 624   virDomainPtr dom = Domain_val (domv);
 625   virConnectPtr conn = Connect_domv (domv);
 626   virConnectPtr dconn = Connect_val (dconnv);
 627   int flags = 0;
 628   const char *dname = Optstring_val (optdnamev);
 629   const char *uri = Optstring_val (opturiv);
 630   unsigned long bandwidth;
 631   virDomainPtr r;
 632
 633   /* Iterate over the list of flags. */
 634   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 635     {
 636       flagv = Field (flagsv, 0);
 637       if (flagv == Val_int (0))
 638         flags |= VIR_MIGRATE_LIVE;
 639     }
 640
 641   if (optbandwidthv == Val_int (0)) /* None */
 642     bandwidth = 0;
 643   else                          /* Some bandwidth */
 644     bandwidth = Int_val (Field (optbandwidthv, 0));
 645
 646   WEAK_SYMBOL_CHECK (virDomainMigrate);
 647   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
 648   CHECK_ERROR (!r, conn, "virDomainMigrate");
 649
 650   rv = Val_domain (r, dconnv);
 651
 652   CAMLreturn (rv);
 653
 654 #else /* virDomainMigrate not supported */
 655   not_supported ("virDomainMigrate");
 656 #endif
 657 }
 658
 659 CAMLprim value
 660 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
 661 {
 662   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
 663                                               argv[3], argv[4], argv[5],
 664                                               argv[6]);
 665 }
 666
 667 #ifdef HAVE_WEAK_SYMBOLS
 668 #ifdef HAVE_VIRDOMAINBLOCKSTATS
 669 extern int virDomainBlockStats (virDomainPtr dom,
 670                                 const char *path,
 671                                 virDomainBlockStatsPtr stats,
 672                                 size_t size)
 673   __attribute__((weak));
 674 #endif
 675 #endif
 676
 677 CAMLprim value
 678 ocaml_libvirt_domain_block_stats (value domv, value pathv)
 679 {
 680 #if HAVE_VIRDOMAINBLOCKSTATS
 681   CAMLparam2 (domv, pathv);
 682   CAMLlocal2 (rv,v);
 683   virDomainPtr dom = Domain_val (domv);
 684   virConnectPtr conn = Connect_domv (domv);
 685   char *path = String_val (pathv);
 686   struct _virDomainBlockStats stats;
 687   int r;
 688
 689   WEAK_SYMBOL_CHECK (virDomainBlockStats);
 690   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
 691   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
 692
 693   rv = caml_alloc (5, 0);
 694   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
 695   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
 696   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
 697   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
 698   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
 699
 700   CAMLreturn (rv);
 701 #else
 702   not_supported ("virDomainBlockStats");
 703 #endif
 704 }
 705
 706 #ifdef HAVE_WEAK_SYMBOLS
 707 #ifdef HAVE_VIRDOMAININTERFACESTATS
 708 extern int virDomainInterfaceStats (virDomainPtr dom,
 709                                     const char *path,
 710                                     virDomainInterfaceStatsPtr stats,
 711                                     size_t size)
 712   __attribute__((weak));
 713 #endif
 714 #endif
 715
 716 CAMLprim value
 717 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 718 {
 719 #if HAVE_VIRDOMAININTERFACESTATS
 720   CAMLparam2 (domv, pathv);
 721   CAMLlocal2 (rv,v);
 722   virDomainPtr dom = Domain_val (domv);
 723   virConnectPtr conn = Connect_domv (domv);
 724   char *path = String_val (pathv);
 725   struct _virDomainInterfaceStats stats;
 726   int r;
 727
 728   WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
 729   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
 730   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
 731
 732   rv = caml_alloc (8, 0);
 733   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
 734   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
 735   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
 736   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
 737   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
 738   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
 739   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
 740   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
 741
 742   CAMLreturn (rv);
 743 #else
 744   not_supported ("virDomainInterfaceStats");
 745 #endif
 746 }
 747
 748 #ifdef HAVE_WEAK_SYMBOLS
 749 #ifdef HAVE_VIRDOMAINBLOCKPEEK
 750 extern int virDomainBlockPeek (virDomainPtr domain,
 751                                const char *path,
 752                                unsigned long long offset,
 753                                size_t size,
 754                                void *buffer,
 755                                unsigned int flags)
 756   __attribute__((weak));
 757 #endif
 758 #endif
 759
 760 CAMLprim value
 761 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
 762 {
 763 #ifdef HAVE_VIRDOMAINBLOCKPEEK
 764   CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
 765   CAMLxparam1 (boffv);
 766   virDomainPtr dom = Domain_val (domv);
 767   virConnectPtr conn = Connect_domv (domv);
 768   const char *path = String_val (pathv);
 769   unsigned long long offset = Int64_val (offsetv);
 770   size_t size = Int_val (sizev);
 771   char *buffer = String_val (bufferv);
 772   int boff = Int_val (boffv);
 773   int r;
 774
 775   /* Check that the return buffer is big enough. */
 776   if (caml_string_length (bufferv) < boff + size)
 777     caml_failwith ("virDomainBlockPeek: return buffer too short");
 778
 779   WEAK_SYMBOL_CHECK (virDomainBlockPeek);
 780   /* NB. not NONBLOCKING because buffer might move (XXX) */
 781   r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
 782   CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
 783
 784   CAMLreturn (Val_unit);
 785
 786 #else /* virDomainBlockPeek not supported */
 787   not_supported ("virDomainBlockPeek");
 788 #endif
 789 }
 790
 791 CAMLprim value
 792 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
 793 {
 794   return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
 795                                                  argv[3], argv[4], argv[5]);
 796 }
 797
 798 #ifdef HAVE_WEAK_SYMBOLS
 799 #ifdef HAVE_VIRDOMAINMEMORYPEEK
 800 extern int virDomainMemoryPeek (virDomainPtr domain,
 801                                 unsigned long long start,
 802                                 size_t size,
 803                                 void *buffer,
 804                                 unsigned int flags)
 805   __attribute__((weak));
 806 #endif
 807 #endif
 808
 809 CAMLprim value
 810 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
 811 {
 812 #ifdef HAVE_VIRDOMAINMEMORYPEEK
 813   CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
 814   CAMLxparam1 (boffv);
 815   CAMLlocal1 (flagv);
 816   virDomainPtr dom = Domain_val (domv);
 817   virConnectPtr conn = Connect_domv (domv);
 818   int flags = 0;
 819   unsigned long long offset = Int64_val (offsetv);
 820   size_t size = Int_val (sizev);
 821   char *buffer = String_val (bufferv);
 822   int boff = Int_val (boffv);
 823   int r;
 824
 825   /* Check that the return buffer is big enough. */
 826   if (caml_string_length (bufferv) < boff + size)
 827     caml_failwith ("virDomainMemoryPeek: return buffer too short");
 828
 829   /* Do flags. */
 830   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 831     {
 832       flagv = Field (flagsv, 0);
 833       if (flagv == Val_int (0))
 834         flags |= VIR_MEMORY_VIRTUAL;
 835     }
 836
 837   WEAK_SYMBOL_CHECK (virDomainMemoryPeek);
 838   /* NB. not NONBLOCKING because buffer might move (XXX) */
 839   r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
 840   CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
 841
 842   CAMLreturn (Val_unit);
 843
 844 #else /* virDomainMemoryPeek not supported */
 845   not_supported ("virDomainMemoryPeek");
 846 #endif
 847 }
 848
 849 CAMLprim value
 850 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
 851 {
 852   return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
 853                                                   argv[3], argv[4], argv[5]);
 854 }
 855
 856 #ifdef HAVE_WEAK_SYMBOLS
 857 #ifdef HAVE_VIRSTORAGEPOOLGETINFO
 858 extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info)
 859   __attribute__((weak));
 860 #endif
 861 #endif
 862
 863 CAMLprim value
 864 ocaml_libvirt_storage_pool_get_info (value poolv)
 865 {
 866 #if HAVE_VIRSTORAGEPOOLGETINFO
 867   CAMLparam1 (poolv);
 868   CAMLlocal2 (rv, v);
 869   virStoragePoolPtr pool = Pool_val (poolv);
 870   virConnectPtr conn = Connect_polv (poolv);
 871   virStoragePoolInfo info;
 872   int r;
 873
 874   WEAK_SYMBOL_CHECK (virStoragePoolGetInfo);
 875   NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
 876   CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo");
 877
 878   rv = caml_alloc (4, 0);
 879   Store_field (rv, 0, Val_int (info.state));
 880   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
 881   v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
 882   v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
 883
 884   CAMLreturn (rv);
 885 #else
 886   not_supported ("virStoragePoolGetInfo");
 887 #endif
 888 }
 889
 890 #ifdef HAVE_WEAK_SYMBOLS
 891 #ifdef HAVE_VIRSTORAGEVOLGETINFO
 892 extern int virStorageVolGetInfo(virStorageVolPtr vol, virStorageVolInfoPtr info)
 893   __attribute__((weak));
 894 #endif
 895 #endif
 896
 897 CAMLprim value
 898 ocaml_libvirt_storage_vol_get_info (value volv)
 899 {
 900 #if HAVE_VIRSTORAGEVOLGETINFO
 901   CAMLparam1 (volv);
 902   CAMLlocal2 (rv, v);
 903   virStorageVolPtr vol = Volume_val (volv);
 904   virConnectPtr conn = Connect_volv (volv);
 905   virStorageVolInfo info;
 906   int r;
 907
 908   WEAK_SYMBOL_CHECK (virStorageVolGetInfo);
 909   NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
 910   CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo");
 911
 912   rv = caml_alloc (3, 0);
 913   Store_field (rv, 0, Val_int (info.type));
 914   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
 915   v = caml_copy_int64 (info.allocation); Store_field (rv, 1, v);
 916
 917   CAMLreturn (rv);
 918 #else
 919   not_supported ("virStorageVolGetInfo");
 920 #endif
 921 }
 922
 923 #ifdef HAVE_WEAK_SYMBOLS
 924 #ifdef HAVE_VIRJOBGETINFO
 925 extern int virJobGetInfo(virJobPtr job, virJobInfoPtr info)
 926   __attribute__((weak));
 927 #endif
 928 #endif
 929
 930 CAMLprim value
 931 ocaml_libvirt_job_get_info (value jobv)
 932 {
 933 #if HAVE_VIRJOBGETINFO
 934   CAMLparam1 (jobv);
 935   CAMLlocal1 (rv);
 936   virJobPtr job = Job_val (jobv);
 937   virConnectPtr conn = Connect_jobv (jobv);
 938   virJobInfo info;
 939   int r;
 940
 941   WEAK_SYMBOL_CHECK (virJobGetInfo);
 942   NONBLOCKING (r = virJobGetInfo (job, &info));
 943   CHECK_ERROR (r == -1, conn, "virJobGetInfo");
 944
 945   rv = caml_alloc (5, 0);
 946   Store_field (rv, 0, Val_int (info.type));
 947   Store_field (rv, 1, Val_int (info.state));
 948   Store_field (rv, 2, Val_int (info.runningTime));
 949   Store_field (rv, 3, Val_int (info.remainingTime));
 950   Store_field (rv, 4, Val_int (info.percentComplete));
 951
 952   CAMLreturn (rv);
 953 #else
 954   not_supported ("virJobGetInfo");
 955 #endif
 956 }
 957
 958 /*----------------------------------------------------------------------*/
 959
 960 CAMLprim value
 961 ocaml_libvirt_virterror_get_last_error (value unitv)
 962 {
 963   CAMLparam1 (unitv);
 964   CAMLlocal1 (rv);
 965   virErrorPtr err = virGetLastError ();
 966
 967   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
 968
 969   CAMLreturn (rv);
 970 }
 971
 972 CAMLprim value
 973 ocaml_libvirt_virterror_get_last_conn_error (value connv)
 974 {
 975   CAMLparam1 (connv);
 976   CAMLlocal1 (rv);
 977   virConnectPtr conn = Connect_val (connv);
 978
 979   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
 980
 981   CAMLreturn (rv);
 982 }
 983
 984 CAMLprim value
 985 ocaml_libvirt_virterror_reset_last_error (value unitv)
 986 {
 987   CAMLparam1 (unitv);
 988   virResetLastError ();
 989   CAMLreturn (Val_unit);
 990 }
 991
 992 CAMLprim value
 993 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
 994 {
 995   CAMLparam1 (connv);
 996   virConnectPtr conn = Connect_val (connv);
 997   virConnResetLastError (conn);
 998   CAMLreturn (Val_unit);
 999 }
1000
1001 /*----------------------------------------------------------------------*/
1002
1003 /* Initialise the library. */
1004 CAMLprim value
1005 ocaml_libvirt_init (value unit)
1006 {
1007   CAMLparam1 (unit);
1008   CAMLlocal1 (rv);
1009   int r;
1010
1011   r = virInitialize ();
1012   CHECK_ERROR (r == -1, NULL, "virInitialize");
1013
1014   CAMLreturn (Val_unit);
1015 }