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