1 /* OCaml bindings for libvirt.
2 * (C) Copyright 2007 Richard W.M. Jones, Red Hat Inc.
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.
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.
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
20 /* Please read libvirt/README file. */
22 #ifdef HAVE_WEAK_SYMBOLS
23 #ifdef HAVE_VIRDOMAINBLOCKSTATS
24 extern int virDomainBlockStats (virDomainPtr dom,
26 virDomainBlockStatsPtr stats,
28 __attribute__((weak));
30 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
31 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
32 virSchedParameterPtr params,
34 __attribute__((weak));
36 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
37 extern char *virDomainGetSchedulerType(virDomainPtr domain,
39 __attribute__((weak));
41 #ifdef HAVE_VIRDOMAININTERFACESTATS
42 extern int virDomainInterfaceStats (virDomainPtr dom,
44 virDomainInterfaceStatsPtr stats,
46 __attribute__((weak));
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));
54 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
55 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
56 virSchedParameterPtr params,
58 __attribute__((weak));
60 #ifdef HAVE_VIRNODEGETFREEMEMORY
61 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
62 __attribute__((weak));
64 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
65 extern int virNodeGetCellsFreeMemory (virConnectPtr conn,
66 unsigned long long *freeMems,
67 int startCell, int maxCells)
68 __attribute__((weak));
70 #endif /* HAVE_WEAK_SYMBOLS */
72 /*----------------------------------------------------------------------*/
75 ocaml_libvirt_get_version (value driverv, value unit)
77 CAMLparam2 (driverv, unit);
79 const char *driver = Optstring_val (driverv);
80 unsigned long libVer, typeVer = 0, *typeVer_ptr;
83 typeVer_ptr = driver ? &typeVer : NULL;
84 NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
85 CHECK_ERROR (r == -1, NULL, "virGetVersion");
87 rv = caml_alloc_tuple (2);
88 Store_field (rv, 0, Val_int (libVer));
89 Store_field (rv, 1, Val_int (typeVer));
93 /*----------------------------------------------------------------------*/
95 /* Connection object. */
98 ocaml_libvirt_connect_open (value namev, value unit)
100 CAMLparam2 (namev, unit);
102 const char *name = Optstring_val (namev);
105 NONBLOCKING (conn = virConnectOpen (name));
106 CHECK_ERROR (!conn, NULL, "virConnectOpen");
108 rv = Val_connect (conn);
114 ocaml_libvirt_connect_open_readonly (value namev, value unit)
116 CAMLparam2 (namev, unit);
118 const char *name = Optstring_val (namev);
121 NONBLOCKING (conn = virConnectOpenReadOnly (name));
122 CHECK_ERROR (!conn, NULL, "virConnectOpen");
124 rv = Val_connect (conn);
130 ocaml_libvirt_connect_get_version (value connv)
133 virConnectPtr conn = Connect_val (connv);
137 NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
138 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
140 CAMLreturn (Val_int (hvVer));
144 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
146 CAMLparam2 (connv, typev);
147 virConnectPtr conn = Connect_val (connv);
148 const char *type = Optstring_val (typev);
151 NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
152 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
154 CAMLreturn (Val_int (r));
158 ocaml_libvirt_connect_get_node_info (value connv)
162 virConnectPtr conn = Connect_val (connv);
166 NONBLOCKING (r = virNodeGetInfo (conn, &info));
167 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
169 rv = caml_alloc (8, 0);
170 v = caml_copy_string (info.model); Store_field (rv, 0, v);
171 v = caml_copy_int64 (info.memory); Store_field (rv, 1, v);
172 Store_field (rv, 2, Val_int (info.cpus));
173 Store_field (rv, 3, Val_int (info.mhz));
174 Store_field (rv, 4, Val_int (info.nodes));
175 Store_field (rv, 5, Val_int (info.sockets));
176 Store_field (rv, 6, Val_int (info.cores));
177 Store_field (rv, 7, Val_int (info.threads));
183 ocaml_libvirt_connect_node_get_free_memory (value connv)
185 #ifdef HAVE_VIRNODEGETFREEMEMORY
188 virConnectPtr conn = Connect_val (connv);
189 unsigned long long r;
191 WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
192 NONBLOCKING (r = virNodeGetFreeMemory (conn));
193 CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
195 rv = caml_copy_int64 ((int64) r);
198 not_supported ("virNodeGetFreeMemory");
203 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
204 value startv, value maxv)
206 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
207 CAMLparam3 (connv, startv, maxv);
209 virConnectPtr conn = Connect_val (connv);
210 int start = Int_val (startv);
211 int max = Int_val (maxv);
213 unsigned long long freemems[max];
215 WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
216 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
217 CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
219 rv = caml_alloc (r, 0);
220 for (i = 0; i < r; ++i) {
221 iv = caml_copy_int64 ((int64) freemems[i]);
222 Store_field (rv, i, iv);
227 not_supported ("virNodeGetCellsFreeMemory");
232 ocaml_libvirt_domain_get_id (value domv)
235 virDomainPtr dom = Domain_val (domv);
236 virConnectPtr conn = Connect_domv (domv);
239 NONBLOCKING (r = virDomainGetID (dom));
240 /* There's a bug in libvirt which means that if you try to get
241 * the ID of a defined-but-not-running domain, it returns -1,
242 * and there's no way to distinguish that from an error.
244 CHECK_ERROR (r == (unsigned int) -1, conn, "virDomainGetID");
246 CAMLreturn (Val_int ((int) r));
250 ocaml_libvirt_domain_get_max_memory (value domv)
254 virDomainPtr dom = Domain_val (domv);
255 virConnectPtr conn = Connect_domv (domv);
258 NONBLOCKING (r = virDomainGetMaxMemory (dom));
259 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
261 rv = caml_copy_int64 (r);
266 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
268 CAMLparam2 (domv, memv);
269 virDomainPtr dom = Domain_val (domv);
270 virConnectPtr conn = Connect_domv (domv);
271 unsigned long mem = Int64_val (memv);
274 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
275 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
277 CAMLreturn (Val_unit);
281 ocaml_libvirt_domain_set_memory (value domv, value memv)
283 CAMLparam2 (domv, memv);
284 virDomainPtr dom = Domain_val (domv);
285 virConnectPtr conn = Connect_domv (domv);
286 unsigned long mem = Int64_val (memv);
289 NONBLOCKING (r = virDomainSetMemory (dom, mem));
290 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
292 CAMLreturn (Val_unit);
296 ocaml_libvirt_domain_get_info (value domv)
300 virDomainPtr dom = Domain_val (domv);
301 virConnectPtr conn = Connect_domv (domv);
305 NONBLOCKING (r = virDomainGetInfo (dom, &info));
306 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
308 rv = caml_alloc (5, 0);
309 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
310 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
311 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
312 Store_field (rv, 3, Val_int (info.nrVirtCpu));
313 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
319 ocaml_libvirt_domain_get_scheduler_type (value domv)
321 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
323 CAMLlocal2 (rv, strv);
324 virDomainPtr dom = Domain_val (domv);
325 virConnectPtr conn = Connect_domv (domv);
329 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
330 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
331 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
333 rv = caml_alloc_tuple (2);
334 strv = caml_copy_string (r); Store_field (rv, 0, strv);
336 Store_field (rv, 1, nparams);
339 not_supported ("virDomainGetSchedulerType");
344 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
346 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
347 CAMLparam2 (domv, nparamsv);
348 CAMLlocal4 (rv, v, v2, v3);
349 virDomainPtr dom = Domain_val (domv);
350 virConnectPtr conn = Connect_domv (domv);
351 int nparams = Int_val (nparamsv);
352 virSchedParameter params[nparams];
355 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
356 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
357 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
359 rv = caml_alloc (nparams, 0);
360 for (i = 0; i < nparams; ++i) {
361 v = caml_alloc_tuple (2); Store_field (rv, i, v);
362 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
363 switch (params[i].type) {
364 case VIR_DOMAIN_SCHED_FIELD_INT:
365 v2 = caml_alloc (1, 0);
366 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
368 case VIR_DOMAIN_SCHED_FIELD_UINT:
369 v2 = caml_alloc (1, 1);
370 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
372 case VIR_DOMAIN_SCHED_FIELD_LLONG:
373 v2 = caml_alloc (1, 2);
374 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
376 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
377 v2 = caml_alloc (1, 3);
378 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
380 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
381 v2 = caml_alloc (1, 4);
382 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
384 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
385 v2 = caml_alloc (1, 5);
386 Store_field (v2, 0, Val_int (params[i].value.b));
389 caml_failwith ((char *)__FUNCTION__);
391 Store_field (v, 1, v2);
395 not_supported ("virDomainGetSchedulerParameters");
400 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
402 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
403 CAMLparam2 (domv, paramsv);
405 virDomainPtr dom = Domain_val (domv);
406 virConnectPtr conn = Connect_domv (domv);
407 int nparams = Wosize_val (paramsv);
408 virSchedParameter params[nparams];
412 for (i = 0; i < nparams; ++i) {
413 v = Field (paramsv, i); /* Points to the two-element tuple. */
414 name = String_val (Field (v, 0));
415 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
416 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
417 v = Field (v, 1); /* Points to the sched_param_value block. */
418 switch (Tag_val (v)) {
420 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
421 params[i].value.i = Int32_val (Field (v, 0));
424 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
425 params[i].value.ui = Int32_val (Field (v, 0));
428 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
429 params[i].value.l = Int64_val (Field (v, 0));
432 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
433 params[i].value.ul = Int64_val (Field (v, 0));
436 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
437 params[i].value.d = Double_val (Field (v, 0));
440 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
441 params[i].value.b = Int_val (Field (v, 0));
444 caml_failwith ((char *)__FUNCTION__);
448 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
449 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
450 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
452 CAMLreturn (Val_unit);
454 not_supported ("virDomainSetSchedulerParameters");
459 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
461 CAMLparam2 (domv, nvcpusv);
462 virDomainPtr dom = Domain_val (domv);
463 virConnectPtr conn = Connect_domv (domv);
464 int r, nvcpus = Int_val (nvcpusv);
466 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
467 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
469 CAMLreturn (Val_unit);
473 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
475 CAMLparam3 (domv, vcpuv, cpumapv);
476 virDomainPtr dom = Domain_val (domv);
477 virConnectPtr conn = Connect_domv (domv);
478 int maplen = caml_string_length (cpumapv);
479 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
480 int vcpu = Int_val (vcpuv);
483 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
484 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
486 CAMLreturn (Val_unit);
490 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
492 CAMLparam3 (domv, maxinfov, maplenv);
493 CAMLlocal5 (rv, infov, strv, v, v2);
494 virDomainPtr dom = Domain_val (domv);
495 virConnectPtr conn = Connect_domv (domv);
496 int maxinfo = Int_val (maxinfov);
497 int maplen = Int_val (maplenv);
498 virVcpuInfo info[maxinfo];
499 unsigned char cpumaps[maxinfo * maplen];
502 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
503 memset (cpumaps, 0, maxinfo * maplen);
505 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
506 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
508 /* Copy the virVcpuInfo structures. */
509 infov = caml_alloc (maxinfo, 0);
510 for (i = 0; i < maxinfo; ++i) {
511 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
512 Store_field (v2, 0, Val_int (info[i].number));
513 Store_field (v2, 1, Val_int (info[i].state));
514 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
515 Store_field (v2, 3, Val_int (info[i].cpu));
518 /* Copy the bitmap. */
519 strv = caml_alloc_string (maxinfo * maplen);
520 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
522 /* Allocate the tuple and return it. */
523 rv = caml_alloc_tuple (3);
524 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
525 Store_field (rv, 1, infov);
526 Store_field (rv, 2, strv);
532 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
534 #ifdef HAVE_VIRDOMAINMIGRATE
535 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
536 CAMLxparam2 (optbandwidthv, unitv);
537 CAMLlocal2 (flagv, rv);
538 virDomainPtr dom = Domain_val (domv);
539 virConnectPtr conn = Connect_domv (domv);
540 virConnectPtr dconn = Connect_val (dconnv);
542 const char *dname = Optstring_val (optdnamev);
543 const char *uri = Optstring_val (opturiv);
544 unsigned long bandwidth;
547 /* Iterate over the list of flags. */
548 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
550 flagv = Field (flagsv, 0);
551 if (flagv == Int_val(0))
552 flags |= VIR_MIGRATE_LIVE;
555 if (optbandwidthv == Val_int (0)) /* None */
557 else /* Some bandwidth */
558 bandwidth = Int_val (Field (optbandwidthv, 0));
560 WEAK_SYMBOL_CHECK (virDomainMigrate);
561 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
562 CHECK_ERROR (!r, conn, "virDomainMigrate");
564 rv = Val_domain (r, dconnv);
568 #else /* virDomainMigrate not supported */
569 not_supported ("virDomainMigrate");
574 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
576 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
577 argv[3], argv[4], argv[5],
582 ocaml_libvirt_domain_block_stats (value domv, value pathv)
584 #if HAVE_VIRDOMAINBLOCKSTATS
585 CAMLparam2 (domv, pathv);
587 virDomainPtr dom = Domain_val (domv);
588 virConnectPtr conn = Connect_domv (domv);
589 char *path = String_val (pathv);
590 struct _virDomainBlockStats stats;
593 WEAK_SYMBOL_CHECK (virDomainBlockStats);
594 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
595 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
597 rv = caml_alloc (5, 0);
598 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
599 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
600 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
601 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
602 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
606 not_supported ("virDomainBlockStats");
611 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
613 #if HAVE_VIRDOMAININTERFACESTATS
614 CAMLparam2 (domv, pathv);
616 virDomainPtr dom = Domain_val (domv);
617 virConnectPtr conn = Connect_domv (domv);
618 char *path = String_val (pathv);
619 struct _virDomainInterfaceStats stats;
622 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
623 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
624 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
626 rv = caml_alloc (8, 0);
627 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
628 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
629 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
630 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
631 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
632 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
633 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
634 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
638 not_supported ("virDomainInterfaceStats");
642 /*----------------------------------------------------------------------*/
645 ocaml_libvirt_virterror_get_last_error (value unitv)
649 virErrorPtr err = virGetLastError ();
651 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
657 ocaml_libvirt_virterror_get_last_conn_error (value connv)
661 virConnectPtr conn = Connect_val (connv);
663 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
669 ocaml_libvirt_virterror_reset_last_error (value unitv)
672 virResetLastError ();
673 CAMLreturn (Val_unit);
677 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
680 virConnectPtr conn = Connect_val (connv);
681 virConnResetLastError (conn);
682 CAMLreturn (Val_unit);
685 /*----------------------------------------------------------------------*/
687 /* Initialise the library. */
689 ocaml_libvirt_init (value unit)
695 r = virInitialize ();
696 CHECK_ERROR (r == -1, NULL, "virInitialize");
698 CAMLreturn (Val_unit);