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