libvirt/libvirt_c_oneoffs.c

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