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_connect_set_keep_alive(value connv,
 173                                      value intervalv, value countv)
 174 {
 175   CAMLparam3 (connv, intervalv, countv);
 176   virConnectPtr conn = Connect_val(connv);
 177   int interval = Int_val(intervalv);
 178   unsigned int count = Int_val(countv);
 179   int r;
 180
 181   NONBLOCKING(r = virConnectSetKeepAlive(conn, interval, count));
 182   CHECK_ERROR (r == -1, conn, "virConnectSetKeepAlive");
 183
 184   CAMLreturn(Val_unit);
 185 }
 186
 187
 188 CAMLprim value
 189 ocaml_libvirt_domain_get_id (value domv)
 190 {
 191   CAMLparam1 (domv);
 192   virDomainPtr dom = Domain_val (domv);
 193   /*virConnectPtr conn = Connect_domv (domv);*/
 194   unsigned int r;
 195
 196   NONBLOCKING (r = virDomainGetID (dom));
 197   /* In theory this could return -1 on error, but in practice
 198    * libvirt never does this unless you call it with a corrupted
 199    * or NULL dom object.  So ignore errors here.
 200    */
 201
 202   CAMLreturn (Val_int ((int) r));
 203 }
 204
 205 CAMLprim value
 206 ocaml_libvirt_domain_get_max_memory (value domv)
 207 {
 208   CAMLparam1 (domv);
 209   CAMLlocal1 (rv);
 210   virDomainPtr dom = Domain_val (domv);
 211   virConnectPtr conn = Connect_domv (domv);
 212   unsigned long r;
 213
 214   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 215   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 216
 217   rv = caml_copy_int64 (r);
 218   CAMLreturn (rv);
 219 }
 220
 221 CAMLprim value
 222 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 223 {
 224   CAMLparam2 (domv, memv);
 225   virDomainPtr dom = Domain_val (domv);
 226   virConnectPtr conn = Connect_domv (domv);
 227   unsigned long mem = Int64_val (memv);
 228   int r;
 229
 230   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 231   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 232
 233   CAMLreturn (Val_unit);
 234 }
 235
 236 CAMLprim value
 237 ocaml_libvirt_domain_set_memory (value domv, value memv)
 238 {
 239   CAMLparam2 (domv, memv);
 240   virDomainPtr dom = Domain_val (domv);
 241   virConnectPtr conn = Connect_domv (domv);
 242   unsigned long mem = Int64_val (memv);
 243   int r;
 244
 245   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 246   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 247
 248   CAMLreturn (Val_unit);
 249 }
 250
 251 CAMLprim value
 252 ocaml_libvirt_domain_get_info (value domv)
 253 {
 254   CAMLparam1 (domv);
 255   CAMLlocal2 (rv, v);
 256   virDomainPtr dom = Domain_val (domv);
 257   virConnectPtr conn = Connect_domv (domv);
 258   virDomainInfo info;
 259   int r;
 260
 261   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 262   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 263
 264   rv = caml_alloc (5, 0);
 265   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 266   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 267   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 268   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 269   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 270
 271   CAMLreturn (rv);
 272 }
 273
 274 CAMLprim value
 275 ocaml_libvirt_domain_get_scheduler_type (value domv)
 276 {
 277   CAMLparam1 (domv);
 278   CAMLlocal2 (rv, strv);
 279   virDomainPtr dom = Domain_val (domv);
 280   virConnectPtr conn = Connect_domv (domv);
 281   char *r;
 282   int nparams;
 283
 284   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
 285   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
 286
 287   rv = caml_alloc_tuple (2);
 288   strv = caml_copy_string (r); Store_field (rv, 0, strv);
 289   free (r);
 290   Store_field (rv, 1, nparams);
 291   CAMLreturn (rv);
 292 }
 293
 294 CAMLprim value
 295 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
 296 {
 297   CAMLparam2 (domv, nparamsv);
 298   CAMLlocal4 (rv, v, v2, v3);
 299   virDomainPtr dom = Domain_val (domv);
 300   virConnectPtr conn = Connect_domv (domv);
 301   int nparams = Int_val (nparamsv);
 302   virSchedParameter params[nparams];
 303   int r, i;
 304
 305   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
 306   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
 307
 308   rv = caml_alloc (nparams, 0);
 309   for (i = 0; i < nparams; ++i) {
 310     v = caml_alloc_tuple (2); Store_field (rv, i, v);
 311     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
 312     switch (params[i].type) {
 313     case VIR_DOMAIN_SCHED_FIELD_INT:
 314       v2 = caml_alloc (1, 0);
 315       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
 316       break;
 317     case VIR_DOMAIN_SCHED_FIELD_UINT:
 318       v2 = caml_alloc (1, 1);
 319       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
 320       break;
 321     case VIR_DOMAIN_SCHED_FIELD_LLONG:
 322       v2 = caml_alloc (1, 2);
 323       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
 324       break;
 325     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
 326       v2 = caml_alloc (1, 3);
 327       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
 328       break;
 329     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
 330       v2 = caml_alloc (1, 4);
 331       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
 332       break;
 333     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
 334       v2 = caml_alloc (1, 5);
 335       Store_field (v2, 0, Val_int (params[i].value.b));
 336       break;
 337     default:
 338       caml_failwith ((char *)__FUNCTION__);
 339     }
 340     Store_field (v, 1, v2);
 341   }
 342   CAMLreturn (rv);
 343 }
 344
 345 CAMLprim value
 346 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
 347 {
 348   CAMLparam2 (domv, paramsv);
 349   CAMLlocal1 (v);
 350   virDomainPtr dom = Domain_val (domv);
 351   virConnectPtr conn = Connect_domv (domv);
 352   int nparams = Wosize_val (paramsv);
 353   virSchedParameter params[nparams];
 354   int r, i;
 355   char *name;
 356
 357   for (i = 0; i < nparams; ++i) {
 358     v = Field (paramsv, i);     /* Points to the two-element tuple. */
 359     name = String_val (Field (v, 0));
 360     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
 361     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
 362     v = Field (v, 1);           /* Points to the sched_param_value block. */
 363     switch (Tag_val (v)) {
 364     case 0:
 365       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
 366       params[i].value.i = Int32_val (Field (v, 0));
 367       break;
 368     case 1:
 369       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
 370       params[i].value.ui = Int32_val (Field (v, 0));
 371       break;
 372     case 2:
 373       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
 374       params[i].value.l = Int64_val (Field (v, 0));
 375       break;
 376     case 3:
 377       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
 378       params[i].value.ul = Int64_val (Field (v, 0));
 379       break;
 380     case 4:
 381       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
 382       params[i].value.d = Double_val (Field (v, 0));
 383       break;
 384     case 5:
 385       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
 386       params[i].value.b = Int_val (Field (v, 0));
 387       break;
 388     default:
 389       caml_failwith ((char *)__FUNCTION__);
 390     }
 391   }
 392
 393   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
 394   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
 395
 396   CAMLreturn (Val_unit);
 397 }
 398
 399 CAMLprim value
 400 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
 401 {
 402   CAMLparam2 (domv, nvcpusv);
 403   virDomainPtr dom = Domain_val (domv);
 404   virConnectPtr conn = Connect_domv (domv);
 405   int r, nvcpus = Int_val (nvcpusv);
 406
 407   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
 408   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
 409
 410   CAMLreturn (Val_unit);
 411 }
 412
 413 CAMLprim value
 414 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
 415 {
 416   CAMLparam3 (domv, vcpuv, cpumapv);
 417   virDomainPtr dom = Domain_val (domv);
 418   virConnectPtr conn = Connect_domv (domv);
 419   int maplen = caml_string_length (cpumapv);
 420   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
 421   int vcpu = Int_val (vcpuv);
 422   int r;
 423
 424   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
 425   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 426
 427   CAMLreturn (Val_unit);
 428 }
 429
 430 CAMLprim value
 431 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 432 {
 433   CAMLparam3 (domv, maxinfov, maplenv);
 434   CAMLlocal5 (rv, infov, strv, v, v2);
 435   virDomainPtr dom = Domain_val (domv);
 436   virConnectPtr conn = Connect_domv (domv);
 437   int maxinfo = Int_val (maxinfov);
 438   int maplen = Int_val (maplenv);
 439   virVcpuInfo info[maxinfo];
 440   unsigned char cpumaps[maxinfo * maplen];
 441   int r, i;
 442
 443   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
 444   memset (cpumaps, 0, maxinfo * maplen);
 445
 446   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
 447   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 448
 449   /* Copy the virVcpuInfo structures. */
 450   infov = caml_alloc (maxinfo, 0);
 451   for (i = 0; i < maxinfo; ++i) {
 452     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
 453     Store_field (v2, 0, Val_int (info[i].number));
 454     Store_field (v2, 1, Val_int (info[i].state));
 455     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
 456     Store_field (v2, 3, Val_int (info[i].cpu));
 457   }
 458
 459   /* Copy the bitmap. */
 460   strv = caml_alloc_string (maxinfo * maplen);
 461   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
 462
 463   /* Allocate the tuple and return it. */
 464   rv = caml_alloc_tuple (3);
 465   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
 466   Store_field (rv, 1, infov);
 467   Store_field (rv, 2, strv);
 468
 469   CAMLreturn (rv);
 470 }
 471
 472 CAMLprim value
 473 ocaml_libvirt_domain_get_cpu_stats (value domv)
 474 {
 475   CAMLparam1 (domv);
 476   CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
 477   CAMLlocal1 (v);
 478   virDomainPtr dom = Domain_val (domv);
 479   virConnectPtr conn = Connect_domv (domv);
 480   virTypedParameterPtr params;
 481   int r, cpu, ncpus, nparams, i, j, pos;
 482   int nr_pcpus;
 483
 484   /* get number of pcpus */
 485   NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
 486   CHECK_ERROR (nr_pcpus < 0, conn, "virDomainGetCPUStats");
 487
 488   /* get percpu information */
 489   NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
 490   CHECK_ERROR (nparams < 0, conn, "virDomainGetCPUStats");
 491
 492   if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
 493     caml_failwith ("virDomainGetCPUStats: malloc");
 494
 495   cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
 496   cpu = 0;
 497   while (cpu < nr_pcpus) {
 498     ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
 499
 500     NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
 501     CHECK_ERROR (r < 0, conn, "virDomainGetCPUStats");
 502
 503     for (i = 0; i < ncpus; i++) {
 504       /* list of typed_param: single linked list of param_nodes */
 505       param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
 506
 507       if (params[i * nparams].type == 0) {
 508         Store_field(cpustats, cpu + i, param_head);
 509         continue;
 510       }
 511
 512       for (j = r - 1; j >= 0; j--) {
 513         pos = i * nparams + j;
 514           if (params[pos].type == 0)
 515             continue;
 516
 517         param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
 518         Store_field(param_node, 1, param_head);
 519         param_head = param_node;
 520
 521         typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
 522         Store_field(param_node, 0, typed_param);
 523         Store_field(typed_param, 0, caml_copy_string(params[pos].field));
 524
 525         /* typed_param_value: value with the corresponding type tag */
 526         switch(params[pos].type) {
 527         case VIR_TYPED_PARAM_INT:
 528           typed_param_value = caml_alloc (1, 0);
 529           v = caml_copy_int32 (params[pos].value.i);
 530           break;
 531         case VIR_TYPED_PARAM_UINT:
 532           typed_param_value = caml_alloc (1, 1);
 533           v = caml_copy_int32 (params[pos].value.ui);
 534           break;
 535         case VIR_TYPED_PARAM_LLONG:
 536           typed_param_value = caml_alloc (1, 2);
 537           v = caml_copy_int64 (params[pos].value.l);
 538           break;
 539         case VIR_TYPED_PARAM_ULLONG:
 540           typed_param_value = caml_alloc (1, 3);
 541           v = caml_copy_int64 (params[pos].value.ul);
 542           break;
 543         case VIR_TYPED_PARAM_DOUBLE:
 544           typed_param_value = caml_alloc (1, 4);
 545           v = caml_copy_double (params[pos].value.d);
 546           break;
 547         case VIR_TYPED_PARAM_BOOLEAN:
 548           typed_param_value = caml_alloc (1, 5);
 549           v = Val_bool (params[pos].value.b);
 550           break;
 551         case VIR_TYPED_PARAM_STRING:
 552           typed_param_value = caml_alloc (1, 6);
 553           v = caml_copy_string (params[pos].value.s);
 554           free (params[pos].value.s);
 555           break;
 556         default:
 557             /* XXX Memory leak on this path, if there are more
 558              * VIR_TYPED_PARAM_STRING past this point in the array.
 559              */
 560           free (params);
 561           caml_failwith ("virDomainGetCPUStats: "
 562                          "unknown parameter type returned");
 563         }
 564         Store_field (typed_param_value, 0, v);
 565         Store_field (typed_param, 1, typed_param_value);
 566       }
 567       Store_field (cpustats, cpu + i, param_head);
 568     }
 569     cpu += ncpus;
 570   }
 571   free(params);
 572   CAMLreturn (cpustats);
 573 }
 574
 575 CAMLprim value
 576 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
 577 {
 578   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
 579   CAMLxparam2 (optbandwidthv, unitv);
 580   CAMLlocal2 (flagv, rv);
 581   virDomainPtr dom = Domain_val (domv);
 582   virConnectPtr conn = Connect_domv (domv);
 583   virConnectPtr dconn = Connect_val (dconnv);
 584   int flags = 0;
 585   const char *dname = Optstring_val (optdnamev);
 586   const char *uri = Optstring_val (opturiv);
 587   unsigned long bandwidth;
 588   virDomainPtr r;
 589
 590   /* Iterate over the list of flags. */
 591   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 592     {
 593       flagv = Field (flagsv, 0);
 594       if (flagv == Val_int (0))
 595         flags |= VIR_MIGRATE_LIVE;
 596     }
 597
 598   if (optbandwidthv == Val_int (0)) /* None */
 599     bandwidth = 0;
 600   else                          /* Some bandwidth */
 601     bandwidth = Int_val (Field (optbandwidthv, 0));
 602
 603   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
 604   CHECK_ERROR (!r, conn, "virDomainMigrate");
 605
 606   rv = Val_domain (r, dconnv);
 607
 608   CAMLreturn (rv);
 609 }
 610
 611 CAMLprim value
 612 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
 613 {
 614   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
 615                                               argv[3], argv[4], argv[5],
 616                                               argv[6]);
 617 }
 618
 619 CAMLprim value
 620 ocaml_libvirt_domain_block_stats (value domv, value pathv)
 621 {
 622   CAMLparam2 (domv, pathv);
 623   CAMLlocal2 (rv,v);
 624   virDomainPtr dom = Domain_val (domv);
 625   virConnectPtr conn = Connect_domv (domv);
 626   char *path = String_val (pathv);
 627   struct _virDomainBlockStats stats;
 628   int r;
 629
 630   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
 631   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
 632
 633   rv = caml_alloc (5, 0);
 634   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
 635   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
 636   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
 637   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
 638   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
 639
 640   CAMLreturn (rv);
 641 }
 642
 643 CAMLprim value
 644 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 645 {
 646   CAMLparam2 (domv, pathv);
 647   CAMLlocal2 (rv,v);
 648   virDomainPtr dom = Domain_val (domv);
 649   virConnectPtr conn = Connect_domv (domv);
 650   char *path = String_val (pathv);
 651   struct _virDomainInterfaceStats stats;
 652   int r;
 653
 654   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
 655   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
 656
 657   rv = caml_alloc (8, 0);
 658   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
 659   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
 660   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
 661   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
 662   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
 663   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
 664   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
 665   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
 666
 667   CAMLreturn (rv);
 668 }
 669
 670 CAMLprim value
 671 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
 672 {
 673   CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
 674   CAMLxparam1 (boffv);
 675   virDomainPtr dom = Domain_val (domv);
 676   virConnectPtr conn = Connect_domv (domv);
 677   const char *path = String_val (pathv);
 678   unsigned long long offset = Int64_val (offsetv);
 679   size_t size = Int_val (sizev);
 680   char *buffer = String_val (bufferv);
 681   int boff = Int_val (boffv);
 682   int r;
 683
 684   /* Check that the return buffer is big enough. */
 685   if (caml_string_length (bufferv) < boff + size)
 686     caml_failwith ("virDomainBlockPeek: return buffer too short");
 687
 688   /* NB. not NONBLOCKING because buffer might move (XXX) */
 689   r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
 690   CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
 691
 692   CAMLreturn (Val_unit);
 693 }
 694
 695 CAMLprim value
 696 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
 697 {
 698   return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
 699                                                  argv[3], argv[4], argv[5]);
 700 }
 701
 702 CAMLprim value
 703 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
 704 {
 705   CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
 706   CAMLxparam1 (boffv);
 707   CAMLlocal1 (flagv);
 708   virDomainPtr dom = Domain_val (domv);
 709   virConnectPtr conn = Connect_domv (domv);
 710   int flags = 0;
 711   unsigned long long offset = Int64_val (offsetv);
 712   size_t size = Int_val (sizev);
 713   char *buffer = String_val (bufferv);
 714   int boff = Int_val (boffv);
 715   int r;
 716
 717   /* Check that the return buffer is big enough. */
 718   if (caml_string_length (bufferv) < boff + size)
 719     caml_failwith ("virDomainMemoryPeek: return buffer too short");
 720
 721   /* Do flags. */
 722   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 723     {
 724       flagv = Field (flagsv, 0);
 725       if (flagv == Val_int (0))
 726         flags |= VIR_MEMORY_VIRTUAL;
 727     }
 728
 729   /* NB. not NONBLOCKING because buffer might move (XXX) */
 730   r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
 731   CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
 732
 733   CAMLreturn (Val_unit);
 734 }
 735
 736 CAMLprim value
 737 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
 738 {
 739   return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
 740                                                   argv[3], argv[4], argv[5]);
 741 }
 742
 743 /*----------------------------------------------------------------------*/
 744
 745 /* Domain events */
 746
 747 CAMLprim value
 748 ocaml_libvirt_event_register_default_impl (value unitv)
 749 {
 750   CAMLparam1 (unitv);
 751
 752   /* arg is of type unit = void */
 753   int r;
 754
 755   NONBLOCKING (r = virEventRegisterDefaultImpl ());
 756   /* must be called before connection, therefore we can't use CHECK_ERROR */
 757   if (r == -1) caml_failwith("virEventRegisterDefaultImpl");
 758
 759   CAMLreturn (Val_unit);
 760 }
 761
 762 CAMLprim value
 763 ocaml_libvirt_event_run_default_impl (value unitv)
 764 {
 765   CAMLparam1 (unitv);
 766
 767   /* arg is of type unit = void */
 768   int r;
 769
 770   NONBLOCKING (r = virEventRunDefaultImpl ());
 771   if (r == -1) caml_failwith("virEventRunDefaultImpl");
 772
 773   CAMLreturn (Val_unit);
 774 }
 775
 776 /* We register a single C callback function for every distinct
 777    callback signature. We encode the signature itself in the function
 778    name and also in the name of the assocated OCaml callback
 779    e.g.:
 780       a C function called
 781          i_i64_s_callback(virConnectPtr conn,
 782                           virDomainPtr dom,
 783                           int x,
 784                           long y,
 785                           char *z,
 786                           void *opaque)
 787       would correspond to an OCaml callback
 788          Libvirt.i_i64_s_callback :
 789            int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit
 790       where the initial int64 is a unique ID used by the OCaml to
 791       dispatch to the specific OCaml closure and stored by libvirt
 792       as the "opaque" data. */
 793
 794 /* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME)
 795    where NAME is the string name of the OCaml callback registered
 796    in libvirt.ml. */
 797 #define DOMAIN_CALLBACK_BEGIN(NAME)                              \
 798   value connv, domv, callback_id, result;                        \
 799   connv = domv = callback_id = result = Val_int(0);              \
 800   static value *callback = NULL;                                 \
 801   caml_leave_blocking_section();                                 \
 802   if (callback == NULL)                                          \
 803     callback = caml_named_value(NAME);                           \
 804   if (callback == NULL)                                          \
 805     abort(); /* C code out of sync with OCaml code */            \
 806   if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1))  \
 807     abort(); /* should never happen in practice? */              \
 808                                                                  \
 809   Begin_roots4(connv, domv, callback_id, result);                \
 810   connv = Val_connect(conn);                                     \
 811   domv = Val_domain(dom, connv);                                 \
 812   callback_id = caml_copy_int64(*(long *)opaque);
 813
 814 /* Every one of the callbacks ends with a CALLBACK_END */
 815 #define DOMAIN_CALLBACK_END                                      \
 816   (void) caml_callback3(*callback, callback_id, domv, result);   \
 817   End_roots();                                                   \
 818   caml_enter_blocking_section();
 819
 820
 821 static void
 822 i_i_callback(virConnectPtr conn,
 823              virDomainPtr dom,
 824              int x,
 825              int y,
 826              void * opaque)
 827 {
 828   DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback")
 829   result = caml_alloc_tuple(2);
 830   Store_field(result, 0, Val_int(x));
 831   Store_field(result, 1, Val_int(y));
 832   DOMAIN_CALLBACK_END
 833 }
 834
 835 static void
 836 u_callback(virConnectPtr conn,
 837            virDomainPtr dom,
 838            void *opaque)
 839 {
 840   DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback")
 841   result = Val_int(0); /* () */
 842   DOMAIN_CALLBACK_END
 843 }
 844
 845 static void
 846 i64_callback(virConnectPtr conn,
 847              virDomainPtr dom,
 848              long long int64,
 849              void *opaque)
 850 {
 851   DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback")
 852   result = caml_copy_int64(int64);
 853   DOMAIN_CALLBACK_END
 854 }
 855
 856 static void
 857 i_callback(virConnectPtr conn,
 858            virDomainPtr dom,
 859            int x,
 860            void *opaque)
 861 {
 862   DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback")
 863   result = Val_int(x);
 864   DOMAIN_CALLBACK_END
 865 }
 866
 867 static void
 868 s_i_callback(virConnectPtr conn,
 869              virDomainPtr dom,
 870              char *x,
 871              int y,
 872              void * opaque)
 873 {
 874   DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback")
 875   result = caml_alloc_tuple(2);
 876   Store_field(result, 0,
 877               Val_opt(x, (Val_ptr_t) caml_copy_string));
 878   Store_field(result, 1, Val_int(y));
 879   DOMAIN_CALLBACK_END
 880 }
 881
 882 static void
 883 s_i_i_callback(virConnectPtr conn,
 884                virDomainPtr dom,
 885                char *x,
 886                int y,
 887                int z,
 888                void * opaque)
 889 {
 890   DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback")
 891   result = caml_alloc_tuple(3);
 892   Store_field(result, 0,
 893               Val_opt(x, (Val_ptr_t) caml_copy_string));
 894   Store_field(result, 1, Val_int(y));
 895   Store_field(result, 2, Val_int(z));
 896   DOMAIN_CALLBACK_END
 897 }
 898
 899 static void
 900 s_s_i_callback(virConnectPtr conn,
 901                virDomainPtr dom,
 902                char *x,
 903                char *y,
 904                int z,
 905                void *opaque)
 906 {
 907   DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback")
 908   result = caml_alloc_tuple(3);
 909   Store_field(result, 0,
 910               Val_opt(x, (Val_ptr_t) caml_copy_string));
 911   Store_field(result, 1,
 912               Val_opt(y, (Val_ptr_t) caml_copy_string));
 913   Store_field(result, 2, Val_int(z));
 914   DOMAIN_CALLBACK_END
 915 }
 916
 917 static void
 918 s_s_i_s_callback(virConnectPtr conn,
 919                  virDomainPtr dom,
 920                  char *x,
 921                  char *y,
 922                  int z,
 923                  char *a,
 924                  void *opaque)
 925 {
 926   DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback")
 927   result = caml_alloc_tuple(4);
 928   Store_field(result, 0,
 929               Val_opt(x, (Val_ptr_t) caml_copy_string));
 930   Store_field(result, 1,
 931               Val_opt(y, (Val_ptr_t) caml_copy_string));
 932   Store_field(result, 2, Val_int(z));
 933   Store_field(result, 3,
 934               Val_opt(a, (Val_ptr_t) caml_copy_string));
 935   DOMAIN_CALLBACK_END
 936 }
 937
 938 static void
 939 s_s_s_i_callback(virConnectPtr conn,
 940                  virDomainPtr dom,
 941                  char * x,
 942                  char * y,
 943                  char * z,
 944                  int a,
 945                  void * opaque)
 946 {
 947   DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback")
 948   result = caml_alloc_tuple(4);
 949   Store_field(result, 0,
 950               Val_opt(x, (Val_ptr_t) caml_copy_string));
 951   Store_field(result, 1,
 952               Val_opt(y, (Val_ptr_t) caml_copy_string));
 953   Store_field(result, 2,
 954               Val_opt(z, (Val_ptr_t) caml_copy_string));
 955   Store_field(result, 3, Val_int(a));
 956   DOMAIN_CALLBACK_END
 957 }
 958
 959 static value
 960 Val_event_graphics_address(virDomainEventGraphicsAddressPtr x)
 961 {
 962   CAMLparam0 ();
 963   CAMLlocal1(result);
 964   result = caml_alloc_tuple(3);
 965   Store_field(result, 0, Val_int(x->family));
 966   Store_field(result, 1,
 967               Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string));
 968   Store_field(result, 2,
 969               Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string));
 970   CAMLreturn(result);
 971 }
 972
 973 static value
 974 Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x)
 975 {
 976   CAMLparam0 ();
 977   CAMLlocal1(result);
 978   result = caml_alloc_tuple(2);
 979   Store_field(result, 0,
 980               Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string));
 981   Store_field(result, 1,
 982               Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string));
 983   CAMLreturn(result);
 984
 985 }
 986
 987 static value
 988 Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x)
 989 {
 990   CAMLparam0 ();
 991   CAMLlocal1(result);
 992   int i;
 993   result = caml_alloc_tuple(x->nidentity);
 994   for (i = 0; i < x->nidentity; i++ )
 995     Store_field(result, i,
 996                 Val_event_graphics_subject_identity(x->identities + i));
 997   CAMLreturn(result);
 998 }
 999
1000 static void
1001 i_ga_ga_s_gs_callback(virConnectPtr conn,
1002                       virDomainPtr dom,
1003                       int i1,
1004                       virDomainEventGraphicsAddressPtr ga1,
1005                       virDomainEventGraphicsAddressPtr ga2,
1006                       char *s1,
1007                       virDomainEventGraphicsSubjectPtr gs1,
1008                       void * opaque)
1009 {
1010   DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback")
1011   result = caml_alloc_tuple(5);
1012   Store_field(result, 0, Val_int(i1));
1013   Store_field(result, 1, Val_event_graphics_address(ga1));
1014   Store_field(result, 2, Val_event_graphics_address(ga2));
1015   Store_field(result, 3,
1016               Val_opt(s1, (Val_ptr_t) caml_copy_string));
1017   Store_field(result, 4, Val_event_graphics_subject(gs1));
1018   DOMAIN_CALLBACK_END
1019 }
1020
1021 static void
1022 timeout_callback(int timer, void *opaque)
1023 {
1024   value callback_id, result;
1025   callback_id = result = Val_int(0);
1026   static value *callback = NULL;
1027   caml_leave_blocking_section();
1028   if (callback == NULL)
1029     callback = caml_named_value("Libvirt.timeout_callback");
1030   if (callback == NULL)
1031     abort(); /* C code out of sync with OCaml code */
1032
1033   Begin_roots2(callback_id, result);
1034   callback_id = caml_copy_int64(*(long *)opaque);
1035
1036   (void)caml_callback_exn(*callback, callback_id);
1037   End_roots();
1038   caml_enter_blocking_section();
1039 }
1040
1041 CAMLprim value
1042 ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id)
1043 {
1044   CAMLparam3 (connv, ms, callback_id);
1045   virConnectPtr conn = Connect_val (connv);
1046   void *opaque;
1047   virFreeCallback freecb = free;
1048   virEventTimeoutCallback cb = timeout_callback;
1049
1050   int r;
1051
1052   /* Store the int64 callback_id as the opaque data so the OCaml
1053      callback can demultiplex to the correct OCaml handler. */
1054   if ((opaque = malloc(sizeof(long))) == NULL)
1055     caml_failwith ("virEventAddTimeout: malloc");
1056   *((long*)opaque) = Int64_val(callback_id);
1057   NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb));
1058   CHECK_ERROR(r == -1, conn, "virEventAddTimeout");
1059
1060   CAMLreturn(Val_int(r));
1061 }
1062
1063 CAMLprim value
1064 ocaml_libvirt_event_remove_timeout (value connv, value timer_id)
1065 {
1066   CAMLparam2 (connv, timer_id);
1067   virConnectPtr conn = Connect_val (connv);
1068   int r;
1069
1070   NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id)));
1071   CHECK_ERROR(r == -1, conn, "virEventRemoveTimeout");
1072
1073   CAMLreturn(Val_int(r));
1074 }
1075
1076 CAMLprim value
1077 ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id)
1078 {
1079   CAMLparam4(connv, domv, callback, callback_id);
1080
1081   virConnectPtr conn = Connect_val (connv);
1082   virDomainPtr dom = NULL;
1083   int eventID = Tag_val(callback);
1084
1085   virConnectDomainEventGenericCallback cb;
1086   void *opaque;
1087   virFreeCallback freecb = free;
1088   int r;
1089
1090   if (domv != Val_int(0))
1091     dom = Domain_val (Field(domv, 0));
1092
1093   switch (eventID){
1094   case VIR_DOMAIN_EVENT_ID_LIFECYCLE:
1095     cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback);
1096     break;
1097   case VIR_DOMAIN_EVENT_ID_REBOOT:
1098     cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1099     break;
1100   case VIR_DOMAIN_EVENT_ID_RTC_CHANGE:
1101     cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1102     break;
1103   case VIR_DOMAIN_EVENT_ID_WATCHDOG:
1104     cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1105     break;
1106   case VIR_DOMAIN_EVENT_ID_IO_ERROR:
1107     cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback);
1108     break;
1109   case VIR_DOMAIN_EVENT_ID_GRAPHICS:
1110     cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback);
1111     break;
1112   case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON:
1113     cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback);
1114     break;
1115   case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR:
1116     cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1117     break;
1118   case VIR_DOMAIN_EVENT_ID_BLOCK_JOB:
1119     cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback);
1120     break;
1121   case VIR_DOMAIN_EVENT_ID_DISK_CHANGE:
1122     cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback);
1123     break;
1124   case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE:
1125     cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback);
1126     break;
1127   case VIR_DOMAIN_EVENT_ID_PMWAKEUP:
1128     cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1129     break;
1130   case VIR_DOMAIN_EVENT_ID_PMSUSPEND:
1131     cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1132     break;
1133   case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE:
1134     cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1135     break;
1136   case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK:
1137     cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1138     break;
1139   default:
1140     caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID");
1141   }
1142
1143   /* Store the int64 callback_id as the opaque data so the OCaml
1144      callback can demultiplex to the correct OCaml handler. */
1145   if ((opaque = malloc(sizeof(long))) == NULL)
1146     caml_failwith ("virConnectDomainEventRegisterAny: malloc");
1147   *((long*)opaque) = Int64_val(callback_id);
1148   NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb));
1149   CHECK_ERROR(r == -1, conn, "virConnectDomainEventRegisterAny");
1150
1151   CAMLreturn(Val_int(r));
1152 }
1153
1154 CAMLprim value
1155 ocaml_libvirt_storage_pool_get_info (value poolv)
1156 {
1157   CAMLparam1 (poolv);
1158   CAMLlocal2 (rv, v);
1159   virStoragePoolPtr pool = Pool_val (poolv);
1160   virConnectPtr conn = Connect_polv (poolv);
1161   virStoragePoolInfo info;
1162   int r;
1163
1164   NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
1165   CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo");
1166
1167   rv = caml_alloc (4, 0);
1168   Store_field (rv, 0, Val_int (info.state));
1169   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1170   v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1171   v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
1172
1173   CAMLreturn (rv);
1174 }
1175
1176 CAMLprim value
1177 ocaml_libvirt_storage_vol_get_info (value volv)
1178 {
1179   CAMLparam1 (volv);
1180   CAMLlocal2 (rv, v);
1181   virStorageVolPtr vol = Volume_val (volv);
1182   virConnectPtr conn = Connect_volv (volv);
1183   virStorageVolInfo info;
1184   int r;
1185
1186   NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
1187   CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo");
1188
1189   rv = caml_alloc (3, 0);
1190   Store_field (rv, 0, Val_int (info.type));
1191   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1192   v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1193
1194   CAMLreturn (rv);
1195 }
1196
1197 /*----------------------------------------------------------------------*/
1198
1199 CAMLprim value
1200 ocaml_libvirt_virterror_get_last_error (value unitv)
1201 {
1202   CAMLparam1 (unitv);
1203   CAMLlocal1 (rv);
1204   virErrorPtr err = virGetLastError ();
1205
1206   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1207
1208   CAMLreturn (rv);
1209 }
1210
1211 CAMLprim value
1212 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1213 {
1214   CAMLparam1 (connv);
1215   CAMLlocal1 (rv);
1216   virConnectPtr conn = Connect_val (connv);
1217
1218   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1219
1220   CAMLreturn (rv);
1221 }
1222
1223 CAMLprim value
1224 ocaml_libvirt_virterror_reset_last_error (value unitv)
1225 {
1226   CAMLparam1 (unitv);
1227   virResetLastError ();
1228   CAMLreturn (Val_unit);
1229 }
1230
1231 CAMLprim value
1232 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1233 {
1234   CAMLparam1 (connv);
1235   virConnectPtr conn = Connect_val (connv);
1236   virConnResetLastError (conn);
1237   CAMLreturn (Val_unit);
1238 }
1239
1240 /*----------------------------------------------------------------------*/
1241
1242 /* Initialise the library. */
1243 CAMLprim value
1244 ocaml_libvirt_init (value unit)
1245 {
1246   CAMLparam1 (unit);
1247   CAMLlocal1 (rv);
1248   int r;
1249
1250   r = virInitialize ();
1251   CHECK_ERROR (r == -1, NULL, "virInitialize");
1252
1253   CAMLreturn (Val_unit);
1254 }