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