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 CAMLprim value
 133 ocaml_libvirt_connect_node_get_free_memory (value connv)
 134 {
 135   CAMLparam1 (connv);
 136   CAMLlocal1 (rv);
 137   virConnectPtr conn = Connect_val (connv);
 138   unsigned long long r;
 139
 140   NONBLOCKING (r = virNodeGetFreeMemory (conn));
 141   CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
 142
 143   rv = caml_copy_int64 ((int64) r);
 144   CAMLreturn (rv);
 145 }
 146
 147 CAMLprim value
 148 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
 149                                                   value startv, value maxv)
 150 {
 151   CAMLparam3 (connv, startv, maxv);
 152   CAMLlocal2 (rv, iv);
 153   virConnectPtr conn = Connect_val (connv);
 154   int start = Int_val (startv);
 155   int max = Int_val (maxv);
 156   int r, i;
 157   unsigned long long freemems[max];
 158
 159   NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
 160   CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
 161
 162   rv = caml_alloc (r, 0);
 163   for (i = 0; i < r; ++i) {
 164     iv = caml_copy_int64 ((int64) freemems[i]);
 165     Store_field (rv, i, iv);
 166   }
 167
 168   CAMLreturn (rv);
 169 }
 170
 171 CAMLprim value
 172 ocaml_libvirt_domain_get_id (value domv)
 173 {
 174   CAMLparam1 (domv);
 175   virDomainPtr dom = Domain_val (domv);
 176   /*virConnectPtr conn = Connect_domv (domv);*/
 177   unsigned int r;
 178
 179   NONBLOCKING (r = virDomainGetID (dom));
 180   /* In theory this could return -1 on error, but in practice
 181    * libvirt never does this unless you call it with a corrupted
 182    * or NULL dom object.  So ignore errors here.
 183    */
 184
 185   CAMLreturn (Val_int ((int) r));
 186 }
 187
 188 CAMLprim value
 189 ocaml_libvirt_domain_get_max_memory (value domv)
 190 {
 191   CAMLparam1 (domv);
 192   CAMLlocal1 (rv);
 193   virDomainPtr dom = Domain_val (domv);
 194   virConnectPtr conn = Connect_domv (domv);
 195   unsigned long r;
 196
 197   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 198   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 199
 200   rv = caml_copy_int64 (r);
 201   CAMLreturn (rv);
 202 }
 203
 204 CAMLprim value
 205 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 206 {
 207   CAMLparam2 (domv, memv);
 208   virDomainPtr dom = Domain_val (domv);
 209   virConnectPtr conn = Connect_domv (domv);
 210   unsigned long mem = Int64_val (memv);
 211   int r;
 212
 213   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 214   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 215
 216   CAMLreturn (Val_unit);
 217 }
 218
 219 CAMLprim value
 220 ocaml_libvirt_domain_set_memory (value domv, value memv)
 221 {
 222   CAMLparam2 (domv, memv);
 223   virDomainPtr dom = Domain_val (domv);
 224   virConnectPtr conn = Connect_domv (domv);
 225   unsigned long mem = Int64_val (memv);
 226   int r;
 227
 228   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 229   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 230
 231   CAMLreturn (Val_unit);
 232 }
 233
 234 CAMLprim value
 235 ocaml_libvirt_domain_get_info (value domv)
 236 {
 237   CAMLparam1 (domv);
 238   CAMLlocal2 (rv, v);
 239   virDomainPtr dom = Domain_val (domv);
 240   virConnectPtr conn = Connect_domv (domv);
 241   virDomainInfo info;
 242   int r;
 243
 244   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 245   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 246
 247   rv = caml_alloc (5, 0);
 248   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 249   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 250   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 251   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 252   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 253
 254   CAMLreturn (rv);
 255 }
 256
 257 CAMLprim value
 258 ocaml_libvirt_domain_get_scheduler_type (value domv)
 259 {
 260   CAMLparam1 (domv);
 261   CAMLlocal2 (rv, strv);
 262   virDomainPtr dom = Domain_val (domv);
 263   virConnectPtr conn = Connect_domv (domv);
 264   char *r;
 265   int nparams;
 266
 267   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
 268   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
 269
 270   rv = caml_alloc_tuple (2);
 271   strv = caml_copy_string (r); Store_field (rv, 0, strv);
 272   free (r);
 273   Store_field (rv, 1, nparams);
 274   CAMLreturn (rv);
 275 }
 276
 277 CAMLprim value
 278 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
 279 {
 280   CAMLparam2 (domv, nparamsv);
 281   CAMLlocal4 (rv, v, v2, v3);
 282   virDomainPtr dom = Domain_val (domv);
 283   virConnectPtr conn = Connect_domv (domv);
 284   int nparams = Int_val (nparamsv);
 285   virSchedParameter params[nparams];
 286   int r, i;
 287
 288   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
 289   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
 290
 291   rv = caml_alloc (nparams, 0);
 292   for (i = 0; i < nparams; ++i) {
 293     v = caml_alloc_tuple (2); Store_field (rv, i, v);
 294     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
 295     switch (params[i].type) {
 296     case VIR_DOMAIN_SCHED_FIELD_INT:
 297       v2 = caml_alloc (1, 0);
 298       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
 299       break;
 300     case VIR_DOMAIN_SCHED_FIELD_UINT:
 301       v2 = caml_alloc (1, 1);
 302       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
 303       break;
 304     case VIR_DOMAIN_SCHED_FIELD_LLONG:
 305       v2 = caml_alloc (1, 2);
 306       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
 307       break;
 308     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
 309       v2 = caml_alloc (1, 3);
 310       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
 311       break;
 312     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
 313       v2 = caml_alloc (1, 4);
 314       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
 315       break;
 316     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
 317       v2 = caml_alloc (1, 5);
 318       Store_field (v2, 0, Val_int (params[i].value.b));
 319       break;
 320     default:
 321       caml_failwith ((char *)__FUNCTION__);
 322     }
 323     Store_field (v, 1, v2);
 324   }
 325   CAMLreturn (rv);
 326 }
 327
 328 CAMLprim value
 329 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
 330 {
 331   CAMLparam2 (domv, paramsv);
 332   CAMLlocal1 (v);
 333   virDomainPtr dom = Domain_val (domv);
 334   virConnectPtr conn = Connect_domv (domv);
 335   int nparams = Wosize_val (paramsv);
 336   virSchedParameter params[nparams];
 337   int r, i;
 338   char *name;
 339
 340   for (i = 0; i < nparams; ++i) {
 341     v = Field (paramsv, i);     /* Points to the two-element tuple. */
 342     name = String_val (Field (v, 0));
 343     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
 344     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
 345     v = Field (v, 1);           /* Points to the sched_param_value block. */
 346     switch (Tag_val (v)) {
 347     case 0:
 348       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
 349       params[i].value.i = Int32_val (Field (v, 0));
 350       break;
 351     case 1:
 352       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
 353       params[i].value.ui = Int32_val (Field (v, 0));
 354       break;
 355     case 2:
 356       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
 357       params[i].value.l = Int64_val (Field (v, 0));
 358       break;
 359     case 3:
 360       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
 361       params[i].value.ul = Int64_val (Field (v, 0));
 362       break;
 363     case 4:
 364       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
 365       params[i].value.d = Double_val (Field (v, 0));
 366       break;
 367     case 5:
 368       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
 369       params[i].value.b = Int_val (Field (v, 0));
 370       break;
 371     default:
 372       caml_failwith ((char *)__FUNCTION__);
 373     }
 374   }
 375
 376   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
 377   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
 378
 379   CAMLreturn (Val_unit);
 380 }
 381
 382 CAMLprim value
 383 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
 384 {
 385   CAMLparam2 (domv, nvcpusv);
 386   virDomainPtr dom = Domain_val (domv);
 387   virConnectPtr conn = Connect_domv (domv);
 388   int r, nvcpus = Int_val (nvcpusv);
 389
 390   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
 391   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
 392
 393   CAMLreturn (Val_unit);
 394 }
 395
 396 CAMLprim value
 397 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
 398 {
 399   CAMLparam3 (domv, vcpuv, cpumapv);
 400   virDomainPtr dom = Domain_val (domv);
 401   virConnectPtr conn = Connect_domv (domv);
 402   int maplen = caml_string_length (cpumapv);
 403   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
 404   int vcpu = Int_val (vcpuv);
 405   int r;
 406
 407   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
 408   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 409
 410   CAMLreturn (Val_unit);
 411 }
 412
 413 CAMLprim value
 414 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 415 {
 416   CAMLparam3 (domv, maxinfov, maplenv);
 417   CAMLlocal5 (rv, infov, strv, v, v2);
 418   virDomainPtr dom = Domain_val (domv);
 419   virConnectPtr conn = Connect_domv (domv);
 420   int maxinfo = Int_val (maxinfov);
 421   int maplen = Int_val (maplenv);
 422   virVcpuInfo info[maxinfo];
 423   unsigned char cpumaps[maxinfo * maplen];
 424   int r, i;
 425
 426   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
 427   memset (cpumaps, 0, maxinfo * maplen);
 428
 429   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
 430   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 431
 432   /* Copy the virVcpuInfo structures. */
 433   infov = caml_alloc (maxinfo, 0);
 434   for (i = 0; i < maxinfo; ++i) {
 435     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
 436     Store_field (v2, 0, Val_int (info[i].number));
 437     Store_field (v2, 1, Val_int (info[i].state));
 438     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
 439     Store_field (v2, 3, Val_int (info[i].cpu));
 440   }
 441
 442   /* Copy the bitmap. */
 443   strv = caml_alloc_string (maxinfo * maplen);
 444   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
 445
 446   /* Allocate the tuple and return it. */
 447   rv = caml_alloc_tuple (3);
 448   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
 449   Store_field (rv, 1, infov);
 450   Store_field (rv, 2, strv);
 451
 452   CAMLreturn (rv);
 453 }
 454
 455 CAMLprim value
 456 ocaml_libvirt_domain_get_cpu_stats (value domv)
 457 {
 458   CAMLparam1 (domv);
 459   CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
 460   CAMLlocal1 (v);
 461   virDomainPtr dom = Domain_val (domv);
 462   virConnectPtr conn = Connect_domv (domv);
 463   virTypedParameterPtr params;
 464   int r, cpu, ncpus, nparams, i, j, pos;
 465   int nr_pcpus;
 466
 467   /* get number of pcpus */
 468   NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
 469   CHECK_ERROR (nr_pcpus < 0, conn, "virDomainGetCPUStats");
 470
 471   /* get percpu information */
 472   NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
 473   CHECK_ERROR (nparams < 0, conn, "virDomainGetCPUStats");
 474
 475   if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
 476     caml_failwith ("virDomainGetCPUStats: malloc");
 477
 478   cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
 479   cpu = 0;
 480   while (cpu < nr_pcpus) {
 481     ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
 482
 483     NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
 484     CHECK_ERROR (r < 0, conn, "virDomainGetCPUStats");
 485
 486     for (i = 0; i < ncpus; i++) {
 487       /* list of typed_param: single linked list of param_nodes */
 488       param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
 489
 490       if (params[i * nparams].type == 0) {
 491         Store_field(cpustats, cpu + i, param_head);
 492         continue;
 493       }
 494
 495       for (j = r - 1; j >= 0; j--) {
 496         pos = i * nparams + j;
 497           if (params[pos].type == 0)
 498             continue;
 499
 500         param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
 501         Store_field(param_node, 1, param_head);
 502         param_head = param_node;
 503
 504         typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
 505         Store_field(param_node, 0, typed_param);
 506         Store_field(typed_param, 0, caml_copy_string(params[pos].field));
 507
 508         /* typed_param_value: value with the corresponding type tag */
 509         switch(params[pos].type) {
 510         case VIR_TYPED_PARAM_INT:
 511           typed_param_value = caml_alloc (1, 0);
 512           v = caml_copy_int32 (params[pos].value.i);
 513           break;
 514         case VIR_TYPED_PARAM_UINT:
 515           typed_param_value = caml_alloc (1, 1);
 516           v = caml_copy_int32 (params[pos].value.ui);
 517           break;
 518         case VIR_TYPED_PARAM_LLONG:
 519           typed_param_value = caml_alloc (1, 2);
 520           v = caml_copy_int64 (params[pos].value.l);
 521           break;
 522         case VIR_TYPED_PARAM_ULLONG:
 523           typed_param_value = caml_alloc (1, 3);
 524           v = caml_copy_int64 (params[pos].value.ul);
 525           break;
 526         case VIR_TYPED_PARAM_DOUBLE:
 527           typed_param_value = caml_alloc (1, 4);
 528           v = caml_copy_double (params[pos].value.d);
 529           break;
 530         case VIR_TYPED_PARAM_BOOLEAN:
 531           typed_param_value = caml_alloc (1, 5);
 532           v = Val_bool (params[pos].value.b);
 533           break;
 534         case VIR_TYPED_PARAM_STRING:
 535           typed_param_value = caml_alloc (1, 6);
 536           v = caml_copy_string (params[pos].value.s);
 537           free (params[pos].value.s);
 538           break;
 539         default:
 540             /* XXX Memory leak on this path, if there are more
 541              * VIR_TYPED_PARAM_STRING past this point in the array.
 542              */
 543           free (params);
 544           caml_failwith ("virDomainGetCPUStats: "
 545                          "unknown parameter type returned");
 546         }
 547         Store_field (typed_param_value, 0, v);
 548         Store_field (typed_param, 1, typed_param_value);
 549       }
 550       Store_field (cpustats, cpu + i, param_head);
 551     }
 552     cpu += ncpus;
 553   }
 554   free(params);
 555   CAMLreturn (cpustats);
 556 }
 557
 558 CAMLprim value
 559 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
 560 {
 561   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
 562   CAMLxparam2 (optbandwidthv, unitv);
 563   CAMLlocal2 (flagv, rv);
 564   virDomainPtr dom = Domain_val (domv);
 565   virConnectPtr conn = Connect_domv (domv);
 566   virConnectPtr dconn = Connect_val (dconnv);
 567   int flags = 0;
 568   const char *dname = Optstring_val (optdnamev);
 569   const char *uri = Optstring_val (opturiv);
 570   unsigned long bandwidth;
 571   virDomainPtr r;
 572
 573   /* Iterate over the list of flags. */
 574   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 575     {
 576       flagv = Field (flagsv, 0);
 577       if (flagv == Val_int (0))
 578         flags |= VIR_MIGRATE_LIVE;
 579     }
 580
 581   if (optbandwidthv == Val_int (0)) /* None */
 582     bandwidth = 0;
 583   else                          /* Some bandwidth */
 584     bandwidth = Int_val (Field (optbandwidthv, 0));
 585
 586   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
 587   CHECK_ERROR (!r, conn, "virDomainMigrate");
 588
 589   rv = Val_domain (r, dconnv);
 590
 591   CAMLreturn (rv);
 592 }
 593
 594 CAMLprim value
 595 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
 596 {
 597   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
 598                                               argv[3], argv[4], argv[5],
 599                                               argv[6]);
 600 }
 601
 602 CAMLprim value
 603 ocaml_libvirt_domain_block_stats (value domv, value pathv)
 604 {
 605   CAMLparam2 (domv, pathv);
 606   CAMLlocal2 (rv,v);
 607   virDomainPtr dom = Domain_val (domv);
 608   virConnectPtr conn = Connect_domv (domv);
 609   char *path = String_val (pathv);
 610   struct _virDomainBlockStats stats;
 611   int r;
 612
 613   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
 614   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
 615
 616   rv = caml_alloc (5, 0);
 617   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
 618   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
 619   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
 620   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
 621   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
 622
 623   CAMLreturn (rv);
 624 }
 625
 626 CAMLprim value
 627 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 628 {
 629   CAMLparam2 (domv, pathv);
 630   CAMLlocal2 (rv,v);
 631   virDomainPtr dom = Domain_val (domv);
 632   virConnectPtr conn = Connect_domv (domv);
 633   char *path = String_val (pathv);
 634   struct _virDomainInterfaceStats stats;
 635   int r;
 636
 637   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
 638   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
 639
 640   rv = caml_alloc (8, 0);
 641   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
 642   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
 643   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
 644   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
 645   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
 646   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
 647   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
 648   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
 649
 650   CAMLreturn (rv);
 651 }
 652
 653 CAMLprim value
 654 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
 655 {
 656   CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
 657   CAMLxparam1 (boffv);
 658   virDomainPtr dom = Domain_val (domv);
 659   virConnectPtr conn = Connect_domv (domv);
 660   const char *path = String_val (pathv);
 661   unsigned long long offset = Int64_val (offsetv);
 662   size_t size = Int_val (sizev);
 663   char *buffer = String_val (bufferv);
 664   int boff = Int_val (boffv);
 665   int r;
 666
 667   /* Check that the return buffer is big enough. */
 668   if (caml_string_length (bufferv) < boff + size)
 669     caml_failwith ("virDomainBlockPeek: return buffer too short");
 670
 671   /* NB. not NONBLOCKING because buffer might move (XXX) */
 672   r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
 673   CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
 674
 675   CAMLreturn (Val_unit);
 676 }
 677
 678 CAMLprim value
 679 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
 680 {
 681   return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
 682                                                  argv[3], argv[4], argv[5]);
 683 }
 684
 685 CAMLprim value
 686 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
 687 {
 688   CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
 689   CAMLxparam1 (boffv);
 690   CAMLlocal1 (flagv);
 691   virDomainPtr dom = Domain_val (domv);
 692   virConnectPtr conn = Connect_domv (domv);
 693   int flags = 0;
 694   unsigned long long offset = Int64_val (offsetv);
 695   size_t size = Int_val (sizev);
 696   char *buffer = String_val (bufferv);
 697   int boff = Int_val (boffv);
 698   int r;
 699
 700   /* Check that the return buffer is big enough. */
 701   if (caml_string_length (bufferv) < boff + size)
 702     caml_failwith ("virDomainMemoryPeek: return buffer too short");
 703
 704   /* Do flags. */
 705   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 706     {
 707       flagv = Field (flagsv, 0);
 708       if (flagv == Val_int (0))
 709         flags |= VIR_MEMORY_VIRTUAL;
 710     }
 711
 712   /* NB. not NONBLOCKING because buffer might move (XXX) */
 713   r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
 714   CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
 715
 716   CAMLreturn (Val_unit);
 717 }
 718
 719 CAMLprim value
 720 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
 721 {
 722   return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
 723                                                   argv[3], argv[4], argv[5]);
 724 }
 725
 726 CAMLprim value
 727 ocaml_libvirt_storage_pool_get_info (value poolv)
 728 {
 729   CAMLparam1 (poolv);
 730   CAMLlocal2 (rv, v);
 731   virStoragePoolPtr pool = Pool_val (poolv);
 732   virConnectPtr conn = Connect_polv (poolv);
 733   virStoragePoolInfo info;
 734   int r;
 735
 736   NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
 737   CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo");
 738
 739   rv = caml_alloc (4, 0);
 740   Store_field (rv, 0, Val_int (info.state));
 741   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
 742   v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
 743   v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
 744
 745   CAMLreturn (rv);
 746 }
 747
 748 CAMLprim value
 749 ocaml_libvirt_storage_vol_get_info (value volv)
 750 {
 751   CAMLparam1 (volv);
 752   CAMLlocal2 (rv, v);
 753   virStorageVolPtr vol = Volume_val (volv);
 754   virConnectPtr conn = Connect_volv (volv);
 755   virStorageVolInfo info;
 756   int r;
 757
 758   NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
 759   CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo");
 760
 761   rv = caml_alloc (3, 0);
 762   Store_field (rv, 0, Val_int (info.type));
 763   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
 764   v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
 765
 766   CAMLreturn (rv);
 767 }
 768
 769 /*----------------------------------------------------------------------*/
 770
 771 CAMLprim value
 772 ocaml_libvirt_virterror_get_last_error (value unitv)
 773 {
 774   CAMLparam1 (unitv);
 775   CAMLlocal1 (rv);
 776   virErrorPtr err = virGetLastError ();
 777
 778   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
 779
 780   CAMLreturn (rv);
 781 }
 782
 783 CAMLprim value
 784 ocaml_libvirt_virterror_get_last_conn_error (value connv)
 785 {
 786   CAMLparam1 (connv);
 787   CAMLlocal1 (rv);
 788   virConnectPtr conn = Connect_val (connv);
 789
 790   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
 791
 792   CAMLreturn (rv);
 793 }
 794
 795 CAMLprim value
 796 ocaml_libvirt_virterror_reset_last_error (value unitv)
 797 {
 798   CAMLparam1 (unitv);
 799   virResetLastError ();
 800   CAMLreturn (Val_unit);
 801 }
 802
 803 CAMLprim value
 804 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
 805 {
 806   CAMLparam1 (connv);
 807   virConnectPtr conn = Connect_val (connv);
 808   virConnResetLastError (conn);
 809   CAMLreturn (Val_unit);
 810 }
 811
 812 /*----------------------------------------------------------------------*/
 813
 814 /* Initialise the library. */
 815 CAMLprim value
 816 ocaml_libvirt_init (value unit)
 817 {
 818   CAMLparam1 (unit);
 819   CAMLlocal1 (rv);
 820   int r;
 821
 822   r = virInitialize ();
 823   CHECK_ERROR (r == -1, NULL, "virInitialize");
 824
 825   CAMLreturn (Val_unit);
 826 }