libvirt/libvirt_c_oneoffs.c

   1 /* OCaml bindings for libvirt.
   2  * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
   3  * http://libvirt.org/
   4  *
   5  * This library is free software; you can redistribute it and/or
   6  * modify it under the terms of the GNU Lesser General Public
   7  * License as published by the Free Software Foundation; either
   8  * version 2 of the License, or (at your option) any later version.
   9  *
  10  * This library is distributed in the hope that it will be useful,
  11  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * Lesser General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU Lesser General Public
  16  * License along with this library; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
  18  */
  19
  20 /* Please read libvirt/README file. */
  21
  22 /*----------------------------------------------------------------------*/
  23
  24 CAMLprim value
  25 ocaml_libvirt_get_version (value driverv, value unit)
  26 {
  27   CAMLparam2 (driverv, unit);
  28   CAMLlocal1 (rv);
  29   const char *driver = Optstring_val (driverv);
  30   unsigned long libVer, typeVer = 0, *typeVer_ptr;
  31   int r;
  32
  33   typeVer_ptr = driver ? &typeVer : NULL;
  34   NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
  35   CHECK_ERROR (r == -1, NULL, "virGetVersion");
  36
  37   rv = caml_alloc_tuple (2);
  38   Store_field (rv, 0, Val_int (libVer));
  39   Store_field (rv, 1, Val_int (typeVer));
  40   CAMLreturn (rv);
  41 }
  42
  43 /*----------------------------------------------------------------------*/
  44
  45 /* Connection object. */
  46
  47 CAMLprim value
  48 ocaml_libvirt_connect_open (value namev, value unit)
  49 {
  50   CAMLparam2 (namev, unit);
  51   CAMLlocal1 (rv);
  52   const char *name = Optstring_val (namev);
  53   virConnectPtr conn;
  54
  55   NONBLOCKING (conn = virConnectOpen (name));
  56   CHECK_ERROR (!conn, NULL, "virConnectOpen");
  57
  58   rv = Val_connect (conn);
  59
  60   CAMLreturn (rv);
  61 }
  62
  63 CAMLprim value
  64 ocaml_libvirt_connect_open_readonly (value namev, value unit)
  65 {
  66   CAMLparam2 (namev, unit);
  67   CAMLlocal1 (rv);
  68   const char *name = Optstring_val (namev);
  69   virConnectPtr conn;
  70
  71   NONBLOCKING (conn = virConnectOpenReadOnly (name));
  72   CHECK_ERROR (!conn, NULL, "virConnectOpen");
  73
  74   rv = Val_connect (conn);
  75
  76   CAMLreturn (rv);
  77 }
  78
  79 CAMLprim value
  80 ocaml_libvirt_connect_get_version (value connv)
  81 {
  82   CAMLparam1 (connv);
  83   virConnectPtr conn = Connect_val (connv);
  84   unsigned long hvVer;
  85   int r;
  86
  87   NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
  88   CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
  89
  90   CAMLreturn (Val_int (hvVer));
  91 }
  92
  93 CAMLprim value
  94 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
  95 {
  96   CAMLparam2 (connv, typev);
  97   virConnectPtr conn = Connect_val (connv);
  98   const char *type = Optstring_val (typev);
  99   int r;
 100
 101   NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
 102   CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
 103
 104   CAMLreturn (Val_int (r));
 105 }
 106
 107 CAMLprim value
 108 ocaml_libvirt_connect_get_node_info (value connv)
 109 {
 110   CAMLparam1 (connv);
 111   CAMLlocal2 (rv, v);
 112   virConnectPtr conn = Connect_val (connv);
 113   virNodeInfo info;
 114   int r;
 115
 116   NONBLOCKING (r = virNodeGetInfo (conn, &info));
 117   CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
 118
 119   rv = caml_alloc (8, 0);
 120   v = caml_copy_string (info.model); Store_field (rv, 0, v);
 121   v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
 122   Store_field (rv, 2, Val_int (info.cpus));
 123   Store_field (rv, 3, Val_int (info.mhz));
 124   Store_field (rv, 4, Val_int (info.nodes));
 125   Store_field (rv, 5, Val_int (info.sockets));
 126   Store_field (rv, 6, Val_int (info.cores));
 127   Store_field (rv, 7, Val_int (info.threads));
 128
 129   CAMLreturn (rv);
 130 }
 131
 132 #ifdef HAVE_WEAK_SYMBOLS
 133 #ifdef HAVE_VIRNODEGETFREEMEMORY
 134 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
 135   __attribute__((weak));
 136 #endif
 137 #endif
 138
 139 CAMLprim value
 140 ocaml_libvirt_connect_node_get_free_memory (value connv)
 141 {
 142 #ifdef HAVE_VIRNODEGETFREEMEMORY
 143   CAMLparam1 (connv);
 144   CAMLlocal1 (rv);
 145   virConnectPtr conn = Connect_val (connv);
 146   unsigned long long r;
 147
 148   WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
 149   NONBLOCKING (r = virNodeGetFreeMemory (conn));
 150   CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
 151
 152   rv = caml_copy_int64 ((int64) r);
 153   CAMLreturn (rv);
 154 #else
 155   not_supported ("virNodeGetFreeMemory");
 156 #endif
 157 }
 158
 159 #ifdef HAVE_WEAK_SYMBOLS
 160 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
 161 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
 162                                       unsigned long long *freeMems,
 163                                       int startCell, int maxCells)
 164   __attribute__((weak));
 165 #endif
 166 #endif
 167
 168 CAMLprim value
 169 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
 170                                                   value startv, value maxv)
 171 {
 172 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
 173   CAMLparam3 (connv, startv, maxv);
 174   CAMLlocal2 (rv, iv);
 175   virConnectPtr conn = Connect_val (connv);
 176   int start = Int_val (startv);
 177   int max = Int_val (maxv);
 178   int r, i;
 179   unsigned long long freemems[max];
 180
 181   WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
 182   NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
 183   CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
 184
 185   rv = caml_alloc (r, 0);
 186   for (i = 0; i < r; ++i) {
 187     iv = caml_copy_int64 ((int64) freemems[i]);
 188     Store_field (rv, i, iv);
 189   }
 190
 191   CAMLreturn (rv);
 192 #else
 193   not_supported ("virNodeGetCellsFreeMemory");
 194 #endif
 195 }
 196
 197 CAMLprim value
 198 ocaml_libvirt_domain_get_id (value domv)
 199 {
 200   CAMLparam1 (domv);
 201   virDomainPtr dom = Domain_val (domv);
 202   virConnectPtr conn = Connect_domv (domv);
 203   unsigned int r;
 204
 205   NONBLOCKING (r = virDomainGetID (dom));
 206   /* There's a bug in libvirt which means that if you try to get
 207    * the ID of a defined-but-not-running domain, it returns -1,
 208    * and there's no way to distinguish that from an error.
 209    */
 210   CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
 211
 212   CAMLreturn (Val_int ((int) r));
 213 }
 214
 215 CAMLprim value
 216 ocaml_libvirt_domain_get_max_memory (value domv)
 217 {
 218   CAMLparam1 (domv);
 219   CAMLlocal1 (rv);
 220   virDomainPtr dom = Domain_val (domv);
 221   virConnectPtr conn = Connect_domv (domv);
 222   unsigned long r;
 223
 224   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 225   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 226
 227   rv = caml_copy_int64 (r);
 228   CAMLreturn (rv);
 229 }
 230
 231 CAMLprim value
 232 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 233 {
 234   CAMLparam2 (domv, memv);
 235   virDomainPtr dom = Domain_val (domv);
 236   virConnectPtr conn = Connect_domv (domv);
 237   unsigned long mem = Int64_val (memv);
 238   int r;
 239
 240   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 241   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 242
 243   CAMLreturn (Val_unit);
 244 }
 245
 246 CAMLprim value
 247 ocaml_libvirt_domain_set_memory (value domv, value memv)
 248 {
 249   CAMLparam2 (domv, memv);
 250   virDomainPtr dom = Domain_val (domv);
 251   virConnectPtr conn = Connect_domv (domv);
 252   unsigned long mem = Int64_val (memv);
 253   int r;
 254
 255   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 256   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 257
 258   CAMLreturn (Val_unit);
 259 }
 260
 261 CAMLprim value
 262 ocaml_libvirt_domain_get_info (value domv)
 263 {
 264   CAMLparam1 (domv);
 265   CAMLlocal2 (rv, v);
 266   virDomainPtr dom = Domain_val (domv);
 267   virConnectPtr conn = Connect_domv (domv);
 268   virDomainInfo info;
 269   int r;
 270
 271   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 272   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 273
 274   rv = caml_alloc (5, 0);
 275   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 276   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 277   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 278   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 279   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 280
 281   CAMLreturn (rv);
 282 }
 283
 284 #ifdef HAVE_WEAK_SYMBOLS
 285 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 286 extern char *virDomainGetSchedulerType(virDomainPtr domain,
 287                                        int *nparams)
 288   __attribute__((weak));
 289 #endif
 290 #endif
 291
 292 CAMLprim value
 293 ocaml_libvirt_domain_get_scheduler_type (value domv)
 294 {
 295 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 296   CAMLparam1 (domv);
 297   CAMLlocal2 (rv, strv);
 298   virDomainPtr dom = Domain_val (domv);
 299   virConnectPtr conn = Connect_domv (domv);
 300   char *r;
 301   int nparams;
 302
 303   WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
 304   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
 305   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
 306
 307   rv = caml_alloc_tuple (2);
 308   strv = caml_copy_string (r); Store_field (rv, 0, strv);
 309   free (r);
 310   Store_field (rv, 1, nparams);
 311   CAMLreturn (rv);
 312 #else
 313   not_supported ("virDomainGetSchedulerType");
 314 #endif
 315 }
 316
 317 #ifdef HAVE_WEAK_SYMBOLS
 318 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 319 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
 320                                             virSchedParameterPtr params,
 321                                             int *nparams)
 322   __attribute__((weak));
 323 #endif
 324 #endif
 325
 326 CAMLprim value
 327 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
 328 {
 329 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 330   CAMLparam2 (domv, nparamsv);
 331   CAMLlocal4 (rv, v, v2, v3);
 332   virDomainPtr dom = Domain_val (domv);
 333   virConnectPtr conn = Connect_domv (domv);
 334   int nparams = Int_val (nparamsv);
 335   virSchedParameter params[nparams];
 336   int r, i;
 337
 338   WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
 339   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
 340   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
 341
 342   rv = caml_alloc (nparams, 0);
 343   for (i = 0; i < nparams; ++i) {
 344     v = caml_alloc_tuple (2); Store_field (rv, i, v);
 345     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
 346     switch (params[i].type) {
 347     case VIR_DOMAIN_SCHED_FIELD_INT:
 348       v2 = caml_alloc (1, 0);
 349       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
 350       break;
 351     case VIR_DOMAIN_SCHED_FIELD_UINT:
 352       v2 = caml_alloc (1, 1);
 353       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
 354       break;
 355     case VIR_DOMAIN_SCHED_FIELD_LLONG:
 356       v2 = caml_alloc (1, 2);
 357       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
 358       break;
 359     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
 360       v2 = caml_alloc (1, 3);
 361       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
 362       break;
 363     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
 364       v2 = caml_alloc (1, 4);
 365       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
 366       break;
 367     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
 368       v2 = caml_alloc (1, 5);
 369       Store_field (v2, 0, Val_int (params[i].value.b));
 370       break;
 371     default:
 372       caml_failwith ((char *)__FUNCTION__);
 373     }
 374     Store_field (v, 1, v2);
 375   }
 376   CAMLreturn (rv);
 377 #else
 378   not_supported ("virDomainGetSchedulerParameters");
 379 #endif
 380 }
 381
 382 #ifdef HAVE_WEAK_SYMBOLS
 383 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 384 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
 385                                             virSchedParameterPtr params,
 386                                             int nparams)
 387   __attribute__((weak));
 388 #endif
 389 #endif
 390
 391 CAMLprim value
 392 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
 393 {
 394 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 395   CAMLparam2 (domv, paramsv);
 396   CAMLlocal1 (v);
 397   virDomainPtr dom = Domain_val (domv);
 398   virConnectPtr conn = Connect_domv (domv);
 399   int nparams = Wosize_val (paramsv);
 400   virSchedParameter params[nparams];
 401   int r, i;
 402   char *name;
 403
 404   for (i = 0; i < nparams; ++i) {
 405     v = Field (paramsv, i);     /* Points to the two-element tuple. */
 406     name = String_val (Field (v, 0));
 407     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
 408     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
 409     v = Field (v, 1);           /* Points to the sched_param_value block. */
 410     switch (Tag_val (v)) {
 411     case 0:
 412       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
 413       params[i].value.i = Int32_val (Field (v, 0));
 414       break;
 415     case 1:
 416       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
 417       params[i].value.ui = Int32_val (Field (v, 0));
 418       break;
 419     case 2:
 420       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
 421       params[i].value.l = Int64_val (Field (v, 0));
 422       break;
 423     case 3:
 424       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
 425       params[i].value.ul = Int64_val (Field (v, 0));
 426       break;
 427     case 4:
 428       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
 429       params[i].value.d = Double_val (Field (v, 0));
 430       break;
 431     case 5:
 432       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
 433       params[i].value.b = Int_val (Field (v, 0));
 434       break;
 435     default:
 436       caml_failwith ((char *)__FUNCTION__);
 437     }
 438   }
 439
 440   WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
 441   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
 442   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
 443
 444   CAMLreturn (Val_unit);
 445 #else
 446   not_supported ("virDomainSetSchedulerParameters");
 447 #endif
 448 }
 449
 450 CAMLprim value
 451 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
 452 {
 453   CAMLparam2 (domv, nvcpusv);
 454   virDomainPtr dom = Domain_val (domv);
 455   virConnectPtr conn = Connect_domv (domv);
 456   int r, nvcpus = Int_val (nvcpusv);
 457
 458   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
 459   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
 460
 461   CAMLreturn (Val_unit);
 462 }
 463
 464 CAMLprim value
 465 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
 466 {
 467   CAMLparam3 (domv, vcpuv, cpumapv);
 468   virDomainPtr dom = Domain_val (domv);
 469   virConnectPtr conn = Connect_domv (domv);
 470   int maplen = caml_string_length (cpumapv);
 471   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
 472   int vcpu = Int_val (vcpuv);
 473   int r;
 474
 475   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
 476   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 477
 478   CAMLreturn (Val_unit);
 479 }
 480
 481 CAMLprim value
 482 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 483 {
 484   CAMLparam3 (domv, maxinfov, maplenv);
 485   CAMLlocal5 (rv, infov, strv, v, v2);
 486   virDomainPtr dom = Domain_val (domv);
 487   virConnectPtr conn = Connect_domv (domv);
 488   int maxinfo = Int_val (maxinfov);
 489   int maplen = Int_val (maplenv);
 490   virVcpuInfo info[maxinfo];
 491   unsigned char cpumaps[maxinfo * maplen];
 492   int r, i;
 493
 494   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
 495   memset (cpumaps, 0, maxinfo * maplen);
 496
 497   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
 498   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 499
 500   /* Copy the virVcpuInfo structures. */
 501   infov = caml_alloc (maxinfo, 0);
 502   for (i = 0; i < maxinfo; ++i) {
 503     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
 504     Store_field (v2, 0, Val_int (info[i].number));
 505     Store_field (v2, 1, Val_int (info[i].state));
 506     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
 507     Store_field (v2, 3, Val_int (info[i].cpu));
 508   }
 509
 510   /* Copy the bitmap. */
 511   strv = caml_alloc_string (maxinfo * maplen);
 512   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
 513
 514   /* Allocate the tuple and return it. */
 515   rv = caml_alloc_tuple (3);
 516   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
 517   Store_field (rv, 1, infov);
 518   Store_field (rv, 2, strv);
 519
 520   CAMLreturn (rv);
 521 }
 522
 523 #ifdef HAVE_WEAK_SYMBOLS
 524 #ifdef HAVE_VIRDOMAINMIGRATE
 525 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
 526                                       unsigned long flags, const char *dname,
 527                                       const char *uri, unsigned long bandwidth)
 528   __attribute__((weak));
 529 #endif
 530 #endif
 531
 532 CAMLprim value
 533 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
 534 {
 535 #ifdef HAVE_VIRDOMAINMIGRATE
 536   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
 537   CAMLxparam2 (optbandwidthv, unitv);
 538   CAMLlocal2 (flagv, rv);
 539   virDomainPtr dom = Domain_val (domv);
 540   virConnectPtr conn = Connect_domv (domv);
 541   virConnectPtr dconn = Connect_val (dconnv);
 542   int flags = 0;
 543   const char *dname = Optstring_val (optdnamev);
 544   const char *uri = Optstring_val (opturiv);
 545   unsigned long bandwidth;
 546   virDomainPtr r;
 547
 548   /* Iterate over the list of flags. */
 549   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 550     {
 551       flagv = Field (flagsv, 0);
 552       if (flagv == Val_int (0))
 553         flags |= VIR_MIGRATE_LIVE;
 554     }
 555
 556   if (optbandwidthv == Val_int (0)) /* None */
 557     bandwidth = 0;
 558   else                          /* Some bandwidth */
 559     bandwidth = Int_val (Field (optbandwidthv, 0));
 560
 561   WEAK_SYMBOL_CHECK (virDomainMigrate);
 562   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
 563   CHECK_ERROR (!r, conn, "virDomainMigrate");
 564
 565   rv = Val_domain (r, dconnv);
 566
 567   CAMLreturn (rv);
 568
 569 #else /* virDomainMigrate not supported */
 570   not_supported ("virDomainMigrate");
 571 #endif
 572 }
 573
 574 CAMLprim value
 575 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
 576 {
 577   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
 578                                               argv[3], argv[4], argv[5],
 579                                               argv[6]);
 580 }
 581
 582 #ifdef HAVE_WEAK_SYMBOLS
 583 #ifdef HAVE_VIRDOMAINBLOCKSTATS
 584 extern int virDomainBlockStats (virDomainPtr dom,
 585                                 const char *path,
 586                                 virDomainBlockStatsPtr stats,
 587                                 size_t size)
 588   __attribute__((weak));
 589 #endif
 590 #endif
 591
 592 CAMLprim value
 593 ocaml_libvirt_domain_block_stats (value domv, value pathv)
 594 {
 595 #if HAVE_VIRDOMAINBLOCKSTATS
 596   CAMLparam2 (domv, pathv);
 597   CAMLlocal2 (rv,v);
 598   virDomainPtr dom = Domain_val (domv);
 599   virConnectPtr conn = Connect_domv (domv);
 600   char *path = String_val (pathv);
 601   struct _virDomainBlockStats stats;
 602   int r;
 603
 604   WEAK_SYMBOL_CHECK (virDomainBlockStats);
 605   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
 606   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
 607
 608   rv = caml_alloc (5, 0);
 609   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
 610   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
 611   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
 612   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
 613   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
 614
 615   CAMLreturn (rv);
 616 #else
 617   not_supported ("virDomainBlockStats");
 618 #endif
 619 }
 620
 621 #ifdef HAVE_WEAK_SYMBOLS
 622 #ifdef HAVE_VIRDOMAININTERFACESTATS
 623 extern int virDomainInterfaceStats (virDomainPtr dom,
 624                                     const char *path,
 625                                     virDomainInterfaceStatsPtr stats,
 626                                     size_t size)
 627   __attribute__((weak));
 628 #endif
 629 #endif
 630
 631 CAMLprim value
 632 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 633 {
 634 #if HAVE_VIRDOMAININTERFACESTATS
 635   CAMLparam2 (domv, pathv);
 636   CAMLlocal2 (rv,v);
 637   virDomainPtr dom = Domain_val (domv);
 638   virConnectPtr conn = Connect_domv (domv);
 639   char *path = String_val (pathv);
 640   struct _virDomainInterfaceStats stats;
 641   int r;
 642
 643   WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
 644   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
 645   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
 646
 647   rv = caml_alloc (8, 0);
 648   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
 649   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
 650   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
 651   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
 652   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
 653   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
 654   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
 655   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
 656
 657   CAMLreturn (rv);
 658 #else
 659   not_supported ("virDomainInterfaceStats");
 660 #endif
 661 }
 662
 663 #ifdef HAVE_WEAK_SYMBOLS
 664 #ifdef HAVE_VIRDOMAINBLOCKPEEK
 665 extern int virDomainBlockPeek (virDomainPtr domain,
 666                                const char *path,
 667                                unsigned long long offset,
 668                                size_t size,
 669                                void *buffer,
 670                                unsigned int flags)
 671   __attribute__((weak));
 672 #endif
 673 #endif
 674
 675 CAMLprim value
 676 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
 677 {
 678 #ifdef HAVE_VIRDOMAINBLOCKPEEK
 679   CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
 680   CAMLxparam1 (boffv);
 681   virDomainPtr dom = Domain_val (domv);
 682   virConnectPtr conn = Connect_domv (domv);
 683   const char *path = String_val (pathv);
 684   unsigned long long offset = Int64_val (offsetv);
 685   size_t size = Int_val (sizev);
 686   char *buffer = String_val (bufferv);
 687   int boff = Int_val (boffv);
 688   int r;
 689
 690   /* Check that the return buffer is big enough. */
 691   if (caml_string_length (bufferv) < boff + size)
 692     caml_failwith ("virDomainBlockPeek: return buffer too short");
 693
 694   WEAK_SYMBOL_CHECK (virDomainBlockPeek);
 695   /* NB. not NONBLOCKING because buffer might move (XXX) */
 696   r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
 697   CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
 698
 699   CAMLreturn (Val_unit);
 700
 701 #else /* virDomainBlockPeek not supported */
 702   not_supported ("virDomainBlockPeek");
 703 #endif
 704 }
 705
 706 CAMLprim value
 707 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
 708 {
 709   return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
 710                                                  argv[3], argv[4], argv[5]);
 711 }
 712
 713 #ifdef HAVE_WEAK_SYMBOLS
 714 #ifdef HAVE_VIRDOMAINMEMORYPEEK
 715 extern int virDomainMemoryPeek (virDomainPtr domain,
 716                                 unsigned long long start,
 717                                 size_t size,
 718                                 void *buffer,
 719                                 unsigned int flags)
 720   __attribute__((weak));
 721 #endif
 722 #endif
 723
 724 CAMLprim value
 725 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
 726 {
 727 #ifdef HAVE_VIRDOMAINMEMORYPEEK
 728   CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
 729   CAMLxparam1 (boffv);
 730   CAMLlocal1 (flagv);
 731   virDomainPtr dom = Domain_val (domv);
 732   virConnectPtr conn = Connect_domv (domv);
 733   int flags = 0;
 734   unsigned long long offset = Int64_val (offsetv);
 735   size_t size = Int_val (sizev);
 736   char *buffer = String_val (bufferv);
 737   int boff = Int_val (boffv);
 738   int r;
 739
 740   /* Check that the return buffer is big enough. */
 741   if (caml_string_length (bufferv) < boff + size)
 742     caml_failwith ("virDomainMemoryPeek: return buffer too short");
 743
 744   /* Do flags. */
 745   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 746     {
 747       flagv = Field (flagsv, 0);
 748       if (flagv == Val_int (0))
 749         flags |= VIR_MEMORY_VIRTUAL;
 750     }
 751
 752   WEAK_SYMBOL_CHECK (virDomainMemoryPeek);
 753   /* NB. not NONBLOCKING because buffer might move (XXX) */
 754   r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
 755   CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
 756
 757   CAMLreturn (Val_unit);
 758
 759 #else /* virDomainMemoryPeek not supported */
 760   not_supported ("virDomainMemoryPeek");
 761 #endif
 762 }
 763
 764 CAMLprim value
 765 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
 766 {
 767   return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
 768                                                   argv[3], argv[4], argv[5]);
 769 }
 770
 771 #ifdef HAVE_WEAK_SYMBOLS
 772 #ifdef HAVE_VIRSTORAGEPOOLGETINFO
 773 extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info)
 774   __attribute__((weak));
 775 #endif
 776 #endif
 777
 778 CAMLprim value
 779 ocaml_libvirt_storage_pool_get_info (value poolv)
 780 {
 781 #if HAVE_VIRSTORAGEPOOLGETINFO
 782   CAMLparam1 (poolv);
 783   CAMLlocal2 (rv, v);
 784   virStoragePoolPtr pool = Pool_val (poolv);
 785   virConnectPtr conn = Connect_polv (poolv);
 786   virStoragePoolInfo info;
 787   int r;
 788
 789   WEAK_SYMBOL_CHECK (virStoragePoolGetInfo);
 790   NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
 791   CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo");
 792
 793   rv = caml_alloc (4, 0);
 794   Store_field (rv, 0, Val_int (info.state));
 795   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
 796   v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
 797   v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
 798
 799   CAMLreturn (rv);
 800 #else
 801   not_supported ("virStoragePoolGetInfo");
 802 #endif
 803 }
 804
 805 #ifdef HAVE_WEAK_SYMBOLS
 806 #ifdef HAVE_VIRSTORAGEVOLGETINFO
 807 extern int virStorageVolGetInfo(virStorageVolPtr vol, virStorageVolInfoPtr info)
 808   __attribute__((weak));
 809 #endif
 810 #endif
 811
 812 CAMLprim value
 813 ocaml_libvirt_storage_vol_get_info (value volv)
 814 {
 815 #if HAVE_VIRSTORAGEVOLGETINFO
 816   CAMLparam1 (volv);
 817   CAMLlocal2 (rv, v);
 818   virStorageVolPtr vol = Volume_val (volv);
 819   virConnectPtr conn = Connect_volv (volv);
 820   virStorageVolInfo info;
 821   int r;
 822
 823   WEAK_SYMBOL_CHECK (virStorageVolGetInfo);
 824   NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
 825   CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo");
 826
 827   rv = caml_alloc (3, 0);
 828   Store_field (rv, 0, Val_int (info.type));
 829   v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
 830   v = caml_copy_int64 (info.allocation); Store_field (rv, 1, v);
 831
 832   CAMLreturn (rv);
 833 #else
 834   not_supported ("virStorageVolGetInfo");
 835 #endif
 836 }
 837
 838 #ifdef HAVE_WEAK_SYMBOLS
 839 #ifdef HAVE_VIRJOBGETINFO
 840 extern int virJobGetInfo(virJobPtr job, virJobInfoPtr info)
 841   __attribute__((weak));
 842 #endif
 843 #endif
 844
 845 CAMLprim value
 846 ocaml_libvirt_job_get_info (value jobv)
 847 {
 848 #if HAVE_VIRJOBGETINFO
 849   CAMLparam1 (jobv);
 850   CAMLlocal1 (rv);
 851   virJobPtr job = Job_val (jobv);
 852   virConnectPtr conn = Connect_jobv (jobv);
 853   virJobInfo info;
 854   int r;
 855
 856   WEAK_SYMBOL_CHECK (virJobGetInfo);
 857   NONBLOCKING (r = virJobGetInfo (job, &info));
 858   CHECK_ERROR (r == -1, conn, "virJobGetInfo");
 859
 860   rv = caml_alloc (5, 0);
 861   Store_field (rv, 0, Val_int (info.type));
 862   Store_field (rv, 1, Val_int (info.state));
 863   Store_field (rv, 2, Val_int (info.runningTime));
 864   Store_field (rv, 3, Val_int (info.remainingTime));
 865   Store_field (rv, 4, Val_int (info.percentComplete));
 866
 867   CAMLreturn (rv);
 868 #else
 869   not_supported ("virJobGetInfo");
 870 #endif
 871 }
 872
 873 /*----------------------------------------------------------------------*/
 874
 875 CAMLprim value
 876 ocaml_libvirt_virterror_get_last_error (value unitv)
 877 {
 878   CAMLparam1 (unitv);
 879   CAMLlocal1 (rv);
 880   virErrorPtr err = virGetLastError ();
 881
 882   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
 883
 884   CAMLreturn (rv);
 885 }
 886
 887 CAMLprim value
 888 ocaml_libvirt_virterror_get_last_conn_error (value connv)
 889 {
 890   CAMLparam1 (connv);
 891   CAMLlocal1 (rv);
 892   virConnectPtr conn = Connect_val (connv);
 893
 894   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
 895
 896   CAMLreturn (rv);
 897 }
 898
 899 CAMLprim value
 900 ocaml_libvirt_virterror_reset_last_error (value unitv)
 901 {
 902   CAMLparam1 (unitv);
 903   virResetLastError ();
 904   CAMLreturn (Val_unit);
 905 }
 906
 907 CAMLprim value
 908 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
 909 {
 910   CAMLparam1 (connv);
 911   virConnectPtr conn = Connect_val (connv);
 912   virConnResetLastError (conn);
 913   CAMLreturn (Val_unit);
 914 }
 915
 916 /*----------------------------------------------------------------------*/
 917
 918 /* Initialise the library. */
 919 CAMLprim value
 920 ocaml_libvirt_init (value unit)
 921 {
 922   CAMLparam1 (unit);
 923   CAMLlocal1 (rv);
 924   int r;
 925
 926   r = virInitialize ();
 927   CHECK_ERROR (r == -1, NULL, "virInitialize");
 928
 929   CAMLreturn (Val_unit);
 930 }