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 #ifdef HAVE_WEAK_SYMBOLS
  23 #ifdef HAVE_VIRDOMAINBLOCKSTATS
  24 extern int virDomainBlockStats (virDomainPtr dom,
  25                                 const char *path,
  26                                 virDomainBlockStatsPtr stats,
  27                                 size_t size)
  28   __attribute__((weak));
  29 #endif
  30 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
  31 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
  32                                             virSchedParameterPtr params,
  33                                             int *nparams)
  34   __attribute__((weak));
  35 #endif
  36 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
  37 extern char *virDomainGetSchedulerType(virDomainPtr domain,
  38                                        int *nparams)
  39   __attribute__((weak));
  40 #endif
  41 #ifdef HAVE_VIRDOMAININTERFACESTATS
  42 extern int virDomainInterfaceStats (virDomainPtr dom,
  43                                     const char *path,
  44                                     virDomainInterfaceStatsPtr stats,
  45                                     size_t size)
  46   __attribute__((weak));
  47 #endif
  48 #ifdef HAVE_VIRDOMAINMIGRATE
  49 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
  50                                       unsigned long flags, const char *dname,
  51                                       const char *uri, unsigned long bandwidth)
  52   __attribute__((weak));
  53 #endif
  54 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
  55 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
  56                                             virSchedParameterPtr params,
  57                                             int nparams)
  58   __attribute__((weak));
  59 #endif
  60 #ifdef HAVE_VIRNODEGETFREEMEMORY
  61 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
  62   __attribute__((weak));
  63 #endif
  64 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
  65 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
  66                                       unsigned long long *freeMems,
  67                                       int startCell, int maxCells)
  68   __attribute__((weak));
  69 #endif
  70 #endif /* HAVE_WEAK_SYMBOLS */
  71
  72 /*----------------------------------------------------------------------*/
  73
  74 CAMLprim value
  75 ocaml_libvirt_get_version (value driverv, value unit)
  76 {
  77   CAMLparam2 (driverv, unit);
  78   CAMLlocal1 (rv);
  79   const char *driver = Optstring_val (driverv);
  80   unsigned long libVer, typeVer = 0, *typeVer_ptr;
  81   int r;
  82
  83   typeVer_ptr = driver ? &typeVer : NULL;
  84   NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
  85   CHECK_ERROR (r == -1, NULL, "virGetVersion");
  86
  87   rv = caml_alloc_tuple (2);
  88   Store_field (rv, 0, Val_int (libVer));
  89   Store_field (rv, 1, Val_int (typeVer));
  90   CAMLreturn (rv);
  91 }
  92
  93 /*----------------------------------------------------------------------*/
  94
  95 /* Connection object. */
  96
  97 CAMLprim value
  98 ocaml_libvirt_connect_open (value namev, value unit)
  99 {
 100   CAMLparam2 (namev, unit);
 101   CAMLlocal1 (rv);
 102   const char *name = Optstring_val (namev);
 103   virConnectPtr conn;
 104
 105   NONBLOCKING (conn = virConnectOpen (name));
 106   CHECK_ERROR (!conn, NULL, "virConnectOpen");
 107
 108   rv = Val_connect (conn);
 109
 110   CAMLreturn (rv);
 111 }
 112
 113 CAMLprim value
 114 ocaml_libvirt_connect_open_readonly (value namev, value unit)
 115 {
 116   CAMLparam2 (namev, unit);
 117   CAMLlocal1 (rv);
 118   const char *name = Optstring_val (namev);
 119   virConnectPtr conn;
 120
 121   NONBLOCKING (conn = virConnectOpenReadOnly (name));
 122   CHECK_ERROR (!conn, NULL, "virConnectOpen");
 123
 124   rv = Val_connect (conn);
 125
 126   CAMLreturn (rv);
 127 }
 128
 129 CAMLprim value
 130 ocaml_libvirt_connect_close (value connv)
 131 {
 132   CAMLparam1 (connv);
 133   virConnectPtr conn = Connect_val (connv);
 134   int r;
 135
 136   NONBLOCKING (r = virConnectClose (conn));
 137   CHECK_ERROR (r == -1, conn, "virConnectClose");
 138
 139   /* So that we don't double-free in the finalizer: */
 140   Connect_val (connv) = NULL;
 141
 142   CAMLreturn (Val_unit);
 143 }
 144
 145 CAMLprim value
 146 ocaml_libvirt_connect_get_version (value connv)
 147 {
 148   CAMLparam1 (connv);
 149   virConnectPtr conn = Connect_val (connv);
 150   unsigned long hvVer;
 151   int r;
 152
 153   NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
 154   CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
 155
 156   CAMLreturn (Val_int (hvVer));
 157 }
 158
 159 CAMLprim value
 160 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
 161 {
 162   CAMLparam2 (connv, typev);
 163   virConnectPtr conn = Connect_val (connv);
 164   const char *type = Optstring_val (typev);
 165   int r;
 166
 167   NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
 168   CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
 169
 170   CAMLreturn (Val_int (r));
 171 }
 172
 173 CAMLprim value
 174 ocaml_libvirt_connect_get_node_info (value connv)
 175 {
 176   CAMLparam1 (connv);
 177   CAMLlocal2 (rv, v);
 178   virConnectPtr conn = Connect_val (connv);
 179   virNodeInfo info;
 180   int r;
 181
 182   NONBLOCKING (r = virNodeGetInfo (conn, &info));
 183   CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
 184
 185   rv = caml_alloc (8, 0);
 186   v = caml_copy_string (info.model); Store_field (rv, 0, v);
 187   v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
 188   Store_field (rv, 2, Val_int (info.cpus));
 189   Store_field (rv, 3, Val_int (info.mhz));
 190   Store_field (rv, 4, Val_int (info.nodes));
 191   Store_field (rv, 5, Val_int (info.sockets));
 192   Store_field (rv, 6, Val_int (info.cores));
 193   Store_field (rv, 7, Val_int (info.threads));
 194
 195   CAMLreturn (rv);
 196 }
 197
 198 CAMLprim value
 199 ocaml_libvirt_connect_node_get_free_memory (value connv)
 200 {
 201 #ifdef HAVE_VIRNODEGETFREEMEMORY
 202   CAMLparam1 (connv);
 203   CAMLlocal1 (rv);
 204   virConnectPtr conn = Connect_val (connv);
 205   unsigned long long r;
 206
 207   WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
 208   NONBLOCKING (r = virNodeGetFreeMemory (conn));
 209   CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
 210
 211   rv = caml_copy_int64 ((int64) r);
 212   CAMLreturn (rv);
 213 #else
 214   not_supported ("virNodeGetFreeMemory");
 215 #endif
 216 }
 217
 218 CAMLprim value
 219 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
 220                                                   value startv, value maxv)
 221 {
 222 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
 223   CAMLparam3 (connv, startv, maxv);
 224   CAMLlocal2 (rv, iv);
 225   virConnectPtr conn = Connect_val (connv);
 226   int start = Int_val (startv);
 227   int max = Int_val (maxv);
 228   int r, i;
 229   unsigned long long freemems[max];
 230
 231   WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
 232   NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
 233   CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
 234
 235   rv = caml_alloc (r, 0);
 236   for (i = 0; i < r; ++i) {
 237     iv = caml_copy_int64 ((int64) freemems[i]);
 238     Store_field (rv, i, iv);
 239   }
 240
 241   CAMLreturn (rv);
 242 #else
 243   not_supported ("virNodeGetCellsFreeMemory");
 244 #endif
 245 }
 246
 247 CAMLprim value
 248 ocaml_libvirt_domain_create_linux (value connv, value xmlv)
 249 {
 250   CAMLparam2 (connv, xmlv);
 251   CAMLlocal1 (rv);
 252   virConnectPtr conn = Connect_val (connv);
 253   char *xml = String_val (xmlv);
 254   virDomainPtr r;
 255
 256   NONBLOCKING (r = virDomainCreateLinux (conn, xml, 0));
 257   CHECK_ERROR (!r, conn, "virDomainCreateLinux");
 258
 259   rv = Val_domain (r, connv);
 260   CAMLreturn (rv);
 261 }
 262
 263 CAMLprim value
 264 ocaml_libvirt_domain_lookup_by_id (value connv, value iv)
 265 {
 266   CAMLparam2 (connv, iv);
 267   CAMLlocal1 (rv);
 268   virConnectPtr conn = Connect_val (connv);
 269   int i = Int_val (iv);
 270   virDomainPtr r;
 271
 272   NONBLOCKING (r = virDomainLookupByID (conn, i));
 273   CHECK_ERROR (!r, conn, "virDomainLookupByID");
 274
 275   rv = Val_domain (r, connv);
 276   CAMLreturn (rv);
 277 }
 278
 279 CAMLprim value
 280 ocaml_libvirt_domain_lookup_by_uuid (value connv, value uuidv)
 281 {
 282   CAMLparam2 (connv, uuidv);
 283   CAMLlocal1 (rv);
 284   virConnectPtr conn = Connect_val (connv);
 285   char *uuid = String_val (uuidv);
 286   virDomainPtr r;
 287
 288   NONBLOCKING (r = virDomainLookupByUUID (conn, (unsigned char *) uuid));
 289   CHECK_ERROR (!r, conn, "virDomainLookupByUUID");
 290
 291   rv = Val_domain (r, connv);
 292   CAMLreturn (rv);
 293 }
 294
 295 CAMLprim value
 296 ocaml_libvirt_domain_lookup_by_uuid_string (value connv, value uuidv)
 297 {
 298   CAMLparam2 (connv, uuidv);
 299   CAMLlocal1 (rv);
 300   virConnectPtr conn = Connect_val (connv);
 301   char *uuid = String_val (uuidv);
 302   virDomainPtr r;
 303
 304   NONBLOCKING (r = virDomainLookupByUUIDString (conn, uuid));
 305   CHECK_ERROR (!r, conn, "virDomainLookupByUUIDString");
 306
 307   rv = Val_domain (r, connv);
 308   CAMLreturn (rv);
 309 }
 310
 311 CAMLprim value
 312 ocaml_libvirt_domain_lookup_by_name (value connv, value namev)
 313 {
 314   CAMLparam2 (connv, namev);
 315   CAMLlocal1 (rv);
 316   virConnectPtr conn = Connect_val (connv);
 317   char *name = String_val (namev);
 318   virDomainPtr r;
 319
 320   NONBLOCKING (r = virDomainLookupByName (conn, name));
 321   CHECK_ERROR (!r, conn, "virDomainLookupByName");
 322
 323   rv = Val_domain (r, connv);
 324   CAMLreturn (rv);
 325 }
 326
 327 CAMLprim value
 328 ocaml_libvirt_domain_destroy (value domv)
 329 {
 330   CAMLparam1 (domv);
 331   virDomainPtr dom = Domain_val (domv);
 332   virConnectPtr conn = Connect_domv (domv);
 333   int r;
 334
 335   NONBLOCKING (r = virDomainDestroy (dom));
 336   CHECK_ERROR (r == -1, conn, "virDomainDestroy");
 337
 338   /* So that we don't double-free in the finalizer: */
 339   Domain_val (domv) = NULL;
 340
 341   CAMLreturn (Val_unit);
 342 }
 343
 344 CAMLprim value
 345 ocaml_libvirt_domain_free (value domv)
 346 {
 347   CAMLparam1 (domv);
 348   virDomainPtr dom = Domain_val (domv);
 349   virConnectPtr conn = Connect_domv (domv);
 350   int r;
 351
 352   NONBLOCKING (r = virDomainFree (dom));
 353   CHECK_ERROR (r == -1, conn, "virDomainFree");
 354
 355   /* So that we don't double-free in the finalizer: */
 356   Domain_val (domv) = NULL;
 357
 358   CAMLreturn (Val_unit);
 359 }
 360
 361 CAMLprim value
 362 ocaml_libvirt_domain_save (value domv, value pathv)
 363 {
 364   CAMLparam2 (domv, pathv);
 365   virDomainPtr dom = Domain_val (domv);
 366   virConnectPtr conn = Connect_domv (domv);
 367   char *path = String_val (pathv);
 368   int r;
 369
 370   NONBLOCKING (r = virDomainSave (dom, path));
 371   CHECK_ERROR (r == -1, conn, "virDomainSave");
 372
 373   CAMLreturn (Val_unit);
 374 }
 375
 376 CAMLprim value
 377 ocaml_libvirt_domain_restore (value connv, value pathv)
 378 {
 379   CAMLparam2 (connv, pathv);
 380   virConnectPtr conn = Connect_val (connv);
 381   char *path = String_val (pathv);
 382   int r;
 383
 384   NONBLOCKING (r = virDomainRestore (conn, path));
 385   CHECK_ERROR (r == -1, conn, "virDomainRestore");
 386
 387   CAMLreturn (Val_unit);
 388 }
 389
 390 CAMLprim value
 391 ocaml_libvirt_domain_core_dump (value domv, value pathv)
 392 {
 393   CAMLparam2 (domv, pathv);
 394   virDomainPtr dom = Domain_val (domv);
 395   virConnectPtr conn = Connect_domv (domv);
 396   char *path = String_val (pathv);
 397   int r;
 398
 399   NONBLOCKING (r = virDomainCoreDump (dom, path, 0));
 400   CHECK_ERROR (r == -1, conn, "virDomainCoreDump");
 401
 402   CAMLreturn (Val_unit);
 403 }
 404
 405 CAMLprim value
 406 ocaml_libvirt_domain_get_uuid (value domv)
 407 {
 408   CAMLparam1 (domv);
 409   CAMLlocal1 (rv);
 410   virDomainPtr dom = Domain_val (domv);
 411   virConnectPtr conn = Connect_domv (domv);
 412   unsigned char uuid[VIR_UUID_BUFLEN];
 413   int r;
 414
 415   NONBLOCKING (r = virDomainGetUUID (dom, uuid));
 416   CHECK_ERROR (r == -1, conn, "virDomainGetUUID");
 417
 418   rv = caml_copy_string ((char *) uuid);
 419   CAMLreturn (rv);
 420 }
 421
 422 CAMLprim value
 423 ocaml_libvirt_domain_get_uuid_string (value domv)
 424 {
 425   CAMLparam1 (domv);
 426   CAMLlocal1 (rv);
 427   virDomainPtr dom = Domain_val (domv);
 428   virConnectPtr conn = Connect_domv (domv);
 429   char uuid[VIR_UUID_STRING_BUFLEN];
 430   int r;
 431
 432   NONBLOCKING (r = virDomainGetUUIDString (dom, uuid));
 433   CHECK_ERROR (r == -1, conn, "virDomainGetUUIDString");
 434
 435   rv = caml_copy_string (uuid);
 436   CAMLreturn (rv);
 437 }
 438
 439 CAMLprim value
 440 ocaml_libvirt_domain_get_id (value domv)
 441 {
 442   CAMLparam1 (domv);
 443   virDomainPtr dom = Domain_val (domv);
 444   virConnectPtr conn = Connect_domv (domv);
 445   unsigned int r;
 446
 447   NONBLOCKING (r = virDomainGetID (dom));
 448   /* There's a bug in libvirt which means that if you try to get
 449    * the ID of a defined-but-not-running domain, it returns -1,
 450    * and there's no way to distinguish that from an error.
 451    */
 452   CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
 453
 454   CAMLreturn (Val_int ((int) r));
 455 }
 456
 457 CAMLprim value
 458 ocaml_libvirt_domain_get_max_memory (value domv)
 459 {
 460   CAMLparam1 (domv);
 461   CAMLlocal1 (rv);
 462   virDomainPtr dom = Domain_val (domv);
 463   virConnectPtr conn = Connect_domv (domv);
 464   unsigned long r;
 465
 466   NONBLOCKING (r = virDomainGetMaxMemory (dom));
 467   CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
 468
 469   rv = caml_copy_int64 (r);
 470   CAMLreturn (rv);
 471 }
 472
 473 CAMLprim value
 474 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
 475 {
 476   CAMLparam2 (domv, memv);
 477   virDomainPtr dom = Domain_val (domv);
 478   virConnectPtr conn = Connect_domv (domv);
 479   unsigned long mem = Int64_val (memv);
 480   int r;
 481
 482   NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
 483   CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
 484
 485   CAMLreturn (Val_unit);
 486 }
 487
 488 CAMLprim value
 489 ocaml_libvirt_domain_set_memory (value domv, value memv)
 490 {
 491   CAMLparam2 (domv, memv);
 492   virDomainPtr dom = Domain_val (domv);
 493   virConnectPtr conn = Connect_domv (domv);
 494   unsigned long mem = Int64_val (memv);
 495   int r;
 496
 497   NONBLOCKING (r = virDomainSetMemory (dom, mem));
 498   CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
 499
 500   CAMLreturn (Val_unit);
 501 }
 502
 503 CAMLprim value
 504 ocaml_libvirt_domain_get_info (value domv)
 505 {
 506   CAMLparam1 (domv);
 507   CAMLlocal2 (rv, v);
 508   virDomainPtr dom = Domain_val (domv);
 509   virConnectPtr conn = Connect_domv (domv);
 510   virDomainInfo info;
 511   int r;
 512
 513   NONBLOCKING (r = virDomainGetInfo (dom, &info));
 514   CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
 515
 516   rv = caml_alloc (5, 0);
 517   Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
 518   v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
 519   v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
 520   Store_field (rv, 3, Val_int (info.nrVirtCpu));
 521   v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
 522
 523   CAMLreturn (rv);
 524 }
 525
 526 CAMLprim value
 527 ocaml_libvirt_domain_get_scheduler_type (value domv)
 528 {
 529 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
 530   CAMLparam1 (domv);
 531   CAMLlocal2 (rv, strv);
 532   virDomainPtr dom = Domain_val (domv);
 533   virConnectPtr conn = Connect_domv (domv);
 534   char *r;
 535   int nparams;
 536
 537   WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
 538   NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
 539   CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
 540
 541   rv = caml_alloc_tuple (2);
 542   strv = caml_copy_string (r); Store_field (rv, 0, strv);
 543   free (r);
 544   Store_field (rv, 1, nparams);
 545   CAMLreturn (rv);
 546 #else
 547   not_supported ("virDomainGetSchedulerType");
 548 #endif
 549 }
 550
 551 CAMLprim value
 552 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
 553 {
 554 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
 555   CAMLparam2 (domv, nparamsv);
 556   CAMLlocal4 (rv, v, v2, v3);
 557   virDomainPtr dom = Domain_val (domv);
 558   virConnectPtr conn = Connect_domv (domv);
 559   int nparams = Int_val (nparamsv);
 560   virSchedParameter params[nparams];
 561   int r, i;
 562
 563   WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
 564   NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
 565   CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
 566
 567   rv = caml_alloc (nparams, 0);
 568   for (i = 0; i < nparams; ++i) {
 569     v = caml_alloc_tuple (2); Store_field (rv, i, v);
 570     v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
 571     switch (params[i].type) {
 572     case VIR_DOMAIN_SCHED_FIELD_INT:
 573       v2 = caml_alloc (1, 0);
 574       v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
 575       break;
 576     case VIR_DOMAIN_SCHED_FIELD_UINT:
 577       v2 = caml_alloc (1, 1);
 578       v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
 579       break;
 580     case VIR_DOMAIN_SCHED_FIELD_LLONG:
 581       v2 = caml_alloc (1, 2);
 582       v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
 583       break;
 584     case VIR_DOMAIN_SCHED_FIELD_ULLONG:
 585       v2 = caml_alloc (1, 3);
 586       v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
 587       break;
 588     case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
 589       v2 = caml_alloc (1, 4);
 590       v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
 591       break;
 592     case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
 593       v2 = caml_alloc (1, 5);
 594       Store_field (v2, 0, Val_int (params[i].value.b));
 595       break;
 596     default:
 597       caml_failwith ((char *)__FUNCTION__);
 598     }
 599     Store_field (v, 1, v2);
 600   }
 601   CAMLreturn (rv);
 602 #else
 603   not_supported ("virDomainGetSchedulerParameters");
 604 #endif
 605 }
 606
 607 CAMLprim value
 608 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
 609 {
 610 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
 611   CAMLparam2 (domv, paramsv);
 612   CAMLlocal1 (v);
 613   virDomainPtr dom = Domain_val (domv);
 614   virConnectPtr conn = Connect_domv (domv);
 615   int nparams = Wosize_val (paramsv);
 616   virSchedParameter params[nparams];
 617   int r, i;
 618   char *name;
 619
 620   for (i = 0; i < nparams; ++i) {
 621     v = Field (paramsv, i);     /* Points to the two-element tuple. */
 622     name = String_val (Field (v, 0));
 623     strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
 624     params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
 625     v = Field (v, 1);           /* Points to the sched_param_value block. */
 626     switch (Tag_val (v)) {
 627     case 0:
 628       params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
 629       params[i].value.i = Int32_val (Field (v, 0));
 630       break;
 631     case 1:
 632       params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
 633       params[i].value.ui = Int32_val (Field (v, 0));
 634       break;
 635     case 2:
 636       params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
 637       params[i].value.l = Int64_val (Field (v, 0));
 638       break;
 639     case 3:
 640       params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
 641       params[i].value.ul = Int64_val (Field (v, 0));
 642       break;
 643     case 4:
 644       params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
 645       params[i].value.d = Double_val (Field (v, 0));
 646       break;
 647     case 5:
 648       params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
 649       params[i].value.b = Int_val (Field (v, 0));
 650       break;
 651     default:
 652       caml_failwith ((char *)__FUNCTION__);
 653     }
 654   }
 655
 656   WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
 657   NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
 658   CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
 659
 660   CAMLreturn (Val_unit);
 661 #else
 662   not_supported ("virDomainSetSchedulerParameters");
 663 #endif
 664 }
 665
 666 CAMLprim value
 667 ocaml_libvirt_domain_define_xml (value connv, value xmlv)
 668 {
 669   CAMLparam2 (connv, xmlv);
 670   CAMLlocal1 (rv);
 671   virConnectPtr conn = Connect_val (connv);
 672   char *xml = String_val (xmlv);
 673   virDomainPtr r;
 674
 675   NONBLOCKING (r = virDomainDefineXML (conn, xml));
 676   CHECK_ERROR (!r, conn, "virDomainDefineXML");
 677
 678   rv = Val_domain (r, connv);
 679   CAMLreturn (rv);
 680 }
 681
 682 CAMLprim value
 683 ocaml_libvirt_domain_get_autostart (value domv)
 684 {
 685   CAMLparam1 (domv);
 686   virDomainPtr dom = Domain_val (domv);
 687   virConnectPtr conn = Connect_domv (domv);
 688   int r, autostart;
 689
 690   NONBLOCKING (r = virDomainGetAutostart (dom, &autostart));
 691   CHECK_ERROR (r == -1, conn, "virDomainGetAutostart");
 692
 693   CAMLreturn (autostart ? Val_true : Val_false);
 694 }
 695
 696 CAMLprim value
 697 ocaml_libvirt_domain_set_autostart (value domv, value autostartv)
 698 {
 699   CAMLparam2 (domv, autostartv);
 700   virDomainPtr dom = Domain_val (domv);
 701   virConnectPtr conn = Connect_domv (domv);
 702   int r, autostart = autostartv == Val_true ? 1 : 0;
 703
 704   NONBLOCKING (r = virDomainSetAutostart (dom, autostart));
 705   CHECK_ERROR (r == -1, conn, "virDomainSetAutostart");
 706
 707   CAMLreturn (Val_unit);
 708 }
 709
 710 CAMLprim value
 711 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
 712 {
 713   CAMLparam2 (domv, nvcpusv);
 714   virDomainPtr dom = Domain_val (domv);
 715   virConnectPtr conn = Connect_domv (domv);
 716   int r, nvcpus = Int_val (nvcpusv);
 717
 718   NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
 719   CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
 720
 721   CAMLreturn (Val_unit);
 722 }
 723
 724 CAMLprim value
 725 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
 726 {
 727   CAMLparam3 (domv, vcpuv, cpumapv);
 728   virDomainPtr dom = Domain_val (domv);
 729   virConnectPtr conn = Connect_domv (domv);
 730   int maplen = caml_string_length (cpumapv);
 731   unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
 732   int vcpu = Int_val (vcpuv);
 733   int r;
 734
 735   NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
 736   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 737
 738   CAMLreturn (Val_unit);
 739 }
 740
 741 CAMLprim value
 742 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
 743 {
 744   CAMLparam3 (domv, maxinfov, maplenv);
 745   CAMLlocal5 (rv, infov, strv, v, v2);
 746   virDomainPtr dom = Domain_val (domv);
 747   virConnectPtr conn = Connect_domv (domv);
 748   int maxinfo = Int_val (maxinfov);
 749   int maplen = Int_val (maplenv);
 750   virVcpuInfo info[maxinfo];
 751   unsigned char cpumaps[maxinfo * maplen];
 752   int r, i;
 753
 754   memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
 755   memset (cpumaps, 0, maxinfo * maplen);
 756
 757   NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
 758   CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
 759
 760   /* Copy the virVcpuInfo structures. */
 761   infov = caml_alloc (maxinfo, 0);
 762   for (i = 0; i < maxinfo; ++i) {
 763     v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
 764     Store_field (v2, 0, Val_int (info[i].number));
 765     Store_field (v2, 1, Val_int (info[i].state));
 766     v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
 767     Store_field (v2, 3, Val_int (info[i].cpu));
 768   }
 769
 770   /* Copy the bitmap. */
 771   strv = caml_alloc_string (maxinfo * maplen);
 772   memcpy (String_val (strv), cpumaps, maxinfo * maplen);
 773
 774   /* Allocate the tuple and return it. */
 775   rv = caml_alloc_tuple (3);
 776   Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
 777   Store_field (rv, 1, infov);
 778   Store_field (rv, 2, strv);
 779
 780   CAMLreturn (rv);
 781 }
 782
 783 CAMLprim value
 784 ocaml_libvirt_domain_get_max_vcpus (value domv)
 785 {
 786   CAMLparam1 (domv);
 787   virDomainPtr dom = Domain_val (domv);
 788   virConnectPtr conn = Connect_domv (domv);
 789   int r;
 790
 791   NONBLOCKING (r = virDomainGetMaxVcpus (dom));
 792   CHECK_ERROR (r == -1, conn, "virDomainGetMaxVcpus");
 793
 794   CAMLreturn (Val_int (r));
 795 }
 796
 797 CAMLprim value
 798 ocaml_libvirt_domain_attach_device (value domv, value xmlv)
 799 {
 800   CAMLparam2 (domv, xmlv);
 801   virDomainPtr dom = Domain_val (domv);
 802   virConnectPtr conn = Connect_domv (domv);
 803   char *xml = String_val (xmlv);
 804   int r;
 805
 806   NONBLOCKING (r = virDomainAttachDevice (dom, xml));
 807   CHECK_ERROR (r == -1, conn, "virDomainAttachDevice");
 808
 809   CAMLreturn (Val_unit);
 810 }
 811
 812 CAMLprim value
 813 ocaml_libvirt_domain_detach_device (value domv, value xmlv)
 814 {
 815   CAMLparam2 (domv, xmlv);
 816   virDomainPtr dom = Domain_val (domv);
 817   virConnectPtr conn = Connect_domv (domv);
 818   char *xml = String_val (xmlv);
 819   int r;
 820
 821   NONBLOCKING (r = virDomainDetachDevice (dom, xml));
 822   CHECK_ERROR (r == -1, conn, "virDomainDetachDevice");
 823
 824   CAMLreturn (Val_unit);
 825 }
 826
 827 CAMLprim value
 828 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
 829 {
 830 #ifdef HAVE_VIRDOMAINMIGRATE
 831   CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
 832   CAMLxparam2 (optbandwidthv, unitv);
 833   CAMLlocal2 (flagv, rv);
 834   virDomainPtr dom = Domain_val (domv);
 835   virConnectPtr conn = Connect_domv (domv);
 836   virConnectPtr dconn = Connect_val (dconnv);
 837   int flags = 0;
 838   const char *dname = Optstring_val (optdnamev);
 839   const char *uri = Optstring_val (opturiv);
 840   unsigned long bandwidth;
 841   virDomainPtr r;
 842
 843   /* Iterate over the list of flags. */
 844   for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
 845     {
 846       flagv = Field (flagsv, 0);
 847       if (flagv == Int_val(0))
 848         flags |= VIR_MIGRATE_LIVE;
 849     }
 850
 851   if (optbandwidthv == Val_int (0)) /* None */
 852     bandwidth = 0;
 853   else                          /* Some bandwidth */
 854     bandwidth = Int_val (Field (optbandwidthv, 0));
 855
 856   WEAK_SYMBOL_CHECK (virDomainMigrate);
 857   NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
 858   CHECK_ERROR (!r, conn, "virDomainMigrate");
 859
 860   rv = Val_domain (r, dconnv);
 861
 862   CAMLreturn (rv);
 863
 864 #else /* virDomainMigrate not supported */
 865   not_supported ("virDomainMigrate");
 866 #endif
 867 }
 868
 869 CAMLprim value
 870 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
 871 {
 872   return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
 873                                               argv[3], argv[4], argv[5],
 874                                               argv[6]);
 875 }
 876
 877 CAMLprim value
 878 ocaml_libvirt_domain_block_stats (value domv, value pathv)
 879 {
 880 #if HAVE_VIRDOMAINBLOCKSTATS
 881   CAMLparam2 (domv, pathv);
 882   CAMLlocal2 (rv,v);
 883   virDomainPtr dom = Domain_val (domv);
 884   virConnectPtr conn = Connect_domv (domv);
 885   char *path = String_val (pathv);
 886   struct _virDomainBlockStats stats;
 887   int r;
 888
 889   WEAK_SYMBOL_CHECK (virDomainBlockStats);
 890   NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
 891   CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
 892
 893   rv = caml_alloc (5, 0);
 894   v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
 895   v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
 896   v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
 897   v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
 898   v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
 899
 900   CAMLreturn (rv);
 901 #else
 902   not_supported ("virDomainBlockStats");
 903 #endif
 904 }
 905
 906 CAMLprim value
 907 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
 908 {
 909 #if HAVE_VIRDOMAININTERFACESTATS
 910   CAMLparam2 (domv, pathv);
 911   CAMLlocal2 (rv,v);
 912   virDomainPtr dom = Domain_val (domv);
 913   virConnectPtr conn = Connect_domv (domv);
 914   char *path = String_val (pathv);
 915   struct _virDomainInterfaceStats stats;
 916   int r;
 917
 918   WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
 919   NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
 920   CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
 921
 922   rv = caml_alloc (8, 0);
 923   v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
 924   v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
 925   v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
 926   v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
 927   v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
 928   v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
 929   v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
 930   v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
 931
 932   CAMLreturn (rv);
 933 #else
 934   not_supported ("virDomainInterfaceStats");
 935 #endif
 936 }
 937
 938 CAMLprim value
 939 ocaml_libvirt_network_lookup_by_name (value connv, value namev)
 940 {
 941   CAMLparam2 (connv, namev);
 942   CAMLlocal1 (rv);
 943   virConnectPtr conn = Connect_val (connv);
 944   char *name = String_val (namev);
 945   virNetworkPtr r;
 946
 947   NONBLOCKING (r = virNetworkLookupByName (conn, name));
 948   CHECK_ERROR (!r, conn, "virNetworkLookupByName");
 949
 950   rv = Val_network (r, connv);
 951   CAMLreturn (rv);
 952 }
 953
 954 CAMLprim value
 955 ocaml_libvirt_network_lookup_by_uuid (value connv, value uuidv)
 956 {
 957   CAMLparam2 (connv, uuidv);
 958   CAMLlocal1 (rv);
 959   virConnectPtr conn = Connect_val (connv);
 960   char *uuid = String_val (uuidv);
 961   virNetworkPtr r;
 962
 963   NONBLOCKING (r = virNetworkLookupByUUID (conn, (unsigned char *) uuid));
 964   CHECK_ERROR (!r, conn, "virNetworkLookupByUUID");
 965
 966   rv = Val_network (r, connv);
 967   CAMLreturn (rv);
 968 }
 969
 970 CAMLprim value
 971 ocaml_libvirt_network_lookup_by_uuid_string (value connv, value uuidv)
 972 {
 973   CAMLparam2 (connv, uuidv);
 974   CAMLlocal1 (rv);
 975   virConnectPtr conn = Connect_val (connv);
 976   char *uuid = String_val (uuidv);
 977   virNetworkPtr r;
 978
 979   NONBLOCKING (r = virNetworkLookupByUUIDString (conn, uuid));
 980   CHECK_ERROR (!r, conn, "virNetworkLookupByUUIDString");
 981
 982   rv = Val_network (r, connv);
 983   CAMLreturn (rv);
 984 }
 985
 986 CAMLprim value
 987 ocaml_libvirt_network_create_xml (value connv, value xmlv)
 988 {
 989   CAMLparam2 (connv, xmlv);
 990   CAMLlocal1 (rv);
 991   virConnectPtr conn = Connect_val (connv);
 992   char *xml = String_val (xmlv);
 993   virNetworkPtr r;
 994
 995   NONBLOCKING (r = virNetworkCreateXML (conn, xml));
 996   CHECK_ERROR (!r, conn, "virNetworkCreateXML");
 997
 998   rv = Val_network (r, connv);
 999   CAMLreturn (rv);
1000 }
1001
1002 CAMLprim value
1003 ocaml_libvirt_network_define_xml (value connv, value xmlv)
1004 {
1005   CAMLparam2 (connv, xmlv);
1006   CAMLlocal1 (rv);
1007   virConnectPtr conn = Connect_val (connv);
1008   char *xml = String_val (xmlv);
1009   virNetworkPtr r;
1010
1011   NONBLOCKING (r = virNetworkDefineXML (conn, xml));
1012   CHECK_ERROR (!r, conn, "virNetworkDefineXML");
1013
1014   rv = Val_network (r, connv);
1015   CAMLreturn (rv);
1016 }
1017
1018 CAMLprim value
1019 ocaml_libvirt_network_destroy (value netv)
1020 {
1021   CAMLparam1 (netv);
1022   virNetworkPtr net = Network_val (netv);
1023   virConnectPtr conn = Connect_netv (netv);
1024   int r;
1025
1026   NONBLOCKING (r = virNetworkDestroy (net));
1027   CHECK_ERROR (r == -1, conn, "virNetworkDestroy");
1028
1029   /* So that we don't double-free in the finalizer: */
1030   Network_val (netv) = NULL;
1031
1032   CAMLreturn (Val_unit);
1033 }
1034
1035 CAMLprim value
1036 ocaml_libvirt_network_free (value netv)
1037 {
1038   CAMLparam1 (netv);
1039   virNetworkPtr net = Network_val (netv);
1040   virConnectPtr conn = Connect_netv (netv);
1041   int r;
1042
1043   NONBLOCKING (r = virNetworkFree (net));
1044   CHECK_ERROR (r == -1, conn, "virNetworkFree");
1045
1046   /* So that we don't double-free in the finalizer: */
1047   Network_val (netv) = NULL;
1048
1049   CAMLreturn (Val_unit);
1050 }
1051
1052 CAMLprim value
1053 ocaml_libvirt_network_get_uuid (value netv)
1054 {
1055   CAMLparam1 (netv);
1056   CAMLlocal1 (rv);
1057   virNetworkPtr net = Network_val (netv);
1058   virConnectPtr conn = Connect_netv (netv);
1059   unsigned char uuid[VIR_UUID_BUFLEN];
1060   int r;
1061
1062   NONBLOCKING (r = virNetworkGetUUID (net, uuid));
1063   CHECK_ERROR (r == -1, conn, "virNetworkGetUUID");
1064
1065   rv = caml_copy_string ((char *) uuid);
1066   CAMLreturn (rv);
1067 }
1068
1069 CAMLprim value
1070 ocaml_libvirt_network_get_uuid_string (value netv)
1071 {
1072   CAMLparam1 (netv);
1073   CAMLlocal1 (rv);
1074   virNetworkPtr net = Network_val (netv);
1075   virConnectPtr conn = Connect_netv (netv);
1076   char uuid[VIR_UUID_STRING_BUFLEN];
1077   int r;
1078
1079   NONBLOCKING (r = virNetworkGetUUIDString (net, uuid));
1080   CHECK_ERROR (r == -1, conn, "virNetworkGetUUIDString");
1081
1082   rv = caml_copy_string (uuid);
1083   CAMLreturn (rv);
1084 }
1085
1086 CAMLprim value
1087 ocaml_libvirt_network_get_autostart (value netv)
1088 {
1089   CAMLparam1 (netv);
1090   virNetworkPtr net = Network_val (netv);
1091   virConnectPtr conn = Connect_netv (netv);
1092   int r, autostart;
1093
1094   NONBLOCKING (r = virNetworkGetAutostart (net, &autostart));
1095   CHECK_ERROR (r == -1, conn, "virNetworkGetAutostart");
1096
1097   CAMLreturn (autostart ? Val_true : Val_false);
1098 }
1099
1100 CAMLprim value
1101 ocaml_libvirt_network_set_autostart (value netv, value autostartv)
1102 {
1103   CAMLparam2 (netv, autostartv);
1104   virNetworkPtr net = Network_val (netv);
1105   virConnectPtr conn = Connect_netv (netv);
1106   int r, autostart = autostartv == Val_true ? 1 : 0;
1107
1108   NONBLOCKING (r = virNetworkSetAutostart (net, autostart));
1109   CHECK_ERROR (r == -1, conn, "virNetworkSetAutostart");
1110
1111   CAMLreturn (Val_unit);
1112 }
1113
1114 /*----------------------------------------------------------------------*/
1115
1116 CAMLprim value
1117 ocaml_libvirt_virterror_get_last_error (value unitv)
1118 {
1119   CAMLparam1 (unitv);
1120   CAMLlocal1 (rv);
1121   virErrorPtr err = virGetLastError ();
1122
1123   rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1124
1125   CAMLreturn (rv);
1126 }
1127
1128 CAMLprim value
1129 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1130 {
1131   CAMLparam1 (connv);
1132   CAMLlocal1 (rv);
1133   virConnectPtr conn = Connect_val (connv);
1134
1135   rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1136
1137   CAMLreturn (rv);
1138 }
1139
1140 CAMLprim value
1141 ocaml_libvirt_virterror_reset_last_error (value unitv)
1142 {
1143   CAMLparam1 (unitv);
1144   virResetLastError ();
1145   CAMLreturn (Val_unit);
1146 }
1147
1148 CAMLprim value
1149 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1150 {
1151   CAMLparam1 (connv);
1152   virConnectPtr conn = Connect_val (connv);
1153   virConnResetLastError (conn);
1154   CAMLreturn (Val_unit);
1155 }
1156
1157 /*----------------------------------------------------------------------*/
1158
1159 /* Initialise the library. */
1160 CAMLprim value
1161 ocaml_libvirt_init (value unit)
1162 {
1163   CAMLparam1 (unit);
1164   CAMLlocal1 (rv);
1165   int r;
1166
1167   r = virInitialize ();
1168   CHECK_ERROR (r == -1, NULL, "virInitialize");
1169
1170   CAMLreturn (Val_unit);
1171 }