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 /*----------------------------------------------------------------------*/
25 ocaml_libvirt_get_version (value driverv, value unit)
27 CAMLparam2 (driverv, unit);
29 const char *driver = Optstring_val (driverv);
30 unsigned long libVer, typeVer = 0, *typeVer_ptr;
33 typeVer_ptr = driver ? &typeVer : NULL;
34 NONBLOCKING (r = virGetVersion (&libVer, driver, typeVer_ptr));
35 CHECK_ERROR (r == -1, NULL, "virGetVersion");
37 rv = caml_alloc_tuple (2);
38 Store_field (rv, 0, Val_int (libVer));
39 Store_field (rv, 1, Val_int (typeVer));
43 /*----------------------------------------------------------------------*/
45 /* Connection object. */
48 ocaml_libvirt_connect_open (value namev, value unit)
50 CAMLparam2 (namev, unit);
52 const char *name = Optstring_val (namev);
55 NONBLOCKING (conn = virConnectOpen (name));
56 CHECK_ERROR (!conn, NULL, "virConnectOpen");
58 rv = Val_connect (conn);
64 ocaml_libvirt_connect_open_readonly (value namev, value unit)
66 CAMLparam2 (namev, unit);
68 const char *name = Optstring_val (namev);
71 NONBLOCKING (conn = virConnectOpenReadOnly (name));
72 CHECK_ERROR (!conn, NULL, "virConnectOpen");
74 rv = Val_connect (conn);
80 ocaml_libvirt_connect_get_version (value connv)
83 virConnectPtr conn = Connect_val (connv);
87 NONBLOCKING (r = virConnectGetVersion (conn, &hvVer));
88 CHECK_ERROR (r == -1, conn, "virConnectGetVersion");
90 CAMLreturn (Val_int (hvVer));
94 ocaml_libvirt_connect_get_max_vcpus (value connv, value typev)
96 CAMLparam2 (connv, typev);
97 virConnectPtr conn = Connect_val (connv);
98 const char *type = Optstring_val (typev);
101 NONBLOCKING (r = virConnectGetMaxVcpus (conn, type));
102 CHECK_ERROR (r == -1, conn, "virConnectGetMaxVcpus");
104 CAMLreturn (Val_int (r));
108 ocaml_libvirt_connect_get_node_info (value connv)
112 virConnectPtr conn = Connect_val (connv);
116 NONBLOCKING (r = virNodeGetInfo (conn, &info));
117 CHECK_ERROR (r == -1, conn, "virNodeGetInfo");
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));
132 #ifdef HAVE_WEAK_SYMBOLS
133 #ifdef HAVE_VIRNODEGETFREEMEMORY
134 extern unsigned long long virNodeGetFreeMemory (virConnectPtr conn)
135 __attribute__((weak));
140 ocaml_libvirt_connect_node_get_free_memory (value connv)
142 #ifdef HAVE_VIRNODEGETFREEMEMORY
145 virConnectPtr conn = Connect_val (connv);
146 unsigned long long r;
148 WEAK_SYMBOL_CHECK (virNodeGetFreeMemory);
149 NONBLOCKING (r = virNodeGetFreeMemory (conn));
150 CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
152 rv = caml_copy_int64 ((int64) r);
155 not_supported ("virNodeGetFreeMemory");
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));
169 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
170 value startv, value maxv)
172 #ifdef HAVE_VIRNODEGETCELLSFREEMEMORY
173 CAMLparam3 (connv, startv, maxv);
175 virConnectPtr conn = Connect_val (connv);
176 int start = Int_val (startv);
177 int max = Int_val (maxv);
179 unsigned long long freemems[max];
181 WEAK_SYMBOL_CHECK (virNodeGetCellsFreeMemory);
182 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
183 CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
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);
193 not_supported ("virNodeGetCellsFreeMemory");
198 ocaml_libvirt_domain_get_id (value domv)
201 virDomainPtr dom = Domain_val (domv);
202 /*virConnectPtr conn = Connect_domv (domv);*/
205 NONBLOCKING (r = virDomainGetID (dom));
206 /* In theory this could return -1 on error, but in practice
207 * libvirt never does this unless you call it with a corrupted
208 * or NULL dom object. So ignore errors here.
211 CAMLreturn (Val_int ((int) r));
215 ocaml_libvirt_domain_get_max_memory (value domv)
219 virDomainPtr dom = Domain_val (domv);
220 virConnectPtr conn = Connect_domv (domv);
223 NONBLOCKING (r = virDomainGetMaxMemory (dom));
224 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
226 rv = caml_copy_int64 (r);
231 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
233 CAMLparam2 (domv, memv);
234 virDomainPtr dom = Domain_val (domv);
235 virConnectPtr conn = Connect_domv (domv);
236 unsigned long mem = Int64_val (memv);
239 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
240 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
242 CAMLreturn (Val_unit);
246 ocaml_libvirt_domain_set_memory (value domv, value memv)
248 CAMLparam2 (domv, memv);
249 virDomainPtr dom = Domain_val (domv);
250 virConnectPtr conn = Connect_domv (domv);
251 unsigned long mem = Int64_val (memv);
254 NONBLOCKING (r = virDomainSetMemory (dom, mem));
255 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
257 CAMLreturn (Val_unit);
261 ocaml_libvirt_domain_get_info (value domv)
265 virDomainPtr dom = Domain_val (domv);
266 virConnectPtr conn = Connect_domv (domv);
270 NONBLOCKING (r = virDomainGetInfo (dom, &info));
271 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
273 rv = caml_alloc (5, 0);
274 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
275 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
276 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
277 Store_field (rv, 3, Val_int (info.nrVirtCpu));
278 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
283 #ifdef HAVE_WEAK_SYMBOLS
284 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
285 extern char *virDomainGetSchedulerType(virDomainPtr domain,
287 __attribute__((weak));
292 ocaml_libvirt_domain_get_scheduler_type (value domv)
294 #ifdef HAVE_VIRDOMAINGETSCHEDULERTYPE
296 CAMLlocal2 (rv, strv);
297 virDomainPtr dom = Domain_val (domv);
298 virConnectPtr conn = Connect_domv (domv);
302 WEAK_SYMBOL_CHECK (virDomainGetSchedulerType);
303 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
304 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
306 rv = caml_alloc_tuple (2);
307 strv = caml_copy_string (r); Store_field (rv, 0, strv);
309 Store_field (rv, 1, nparams);
312 not_supported ("virDomainGetSchedulerType");
316 #ifdef HAVE_WEAK_SYMBOLS
317 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
318 extern int virDomainGetSchedulerParameters (virDomainPtr domain,
319 virSchedParameterPtr params,
321 __attribute__((weak));
326 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
328 #ifdef HAVE_VIRDOMAINGETSCHEDULERPARAMETERS
329 CAMLparam2 (domv, nparamsv);
330 CAMLlocal4 (rv, v, v2, v3);
331 virDomainPtr dom = Domain_val (domv);
332 virConnectPtr conn = Connect_domv (domv);
333 int nparams = Int_val (nparamsv);
334 virSchedParameter params[nparams];
337 WEAK_SYMBOL_CHECK (virDomainGetSchedulerParameters);
338 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
339 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
341 rv = caml_alloc (nparams, 0);
342 for (i = 0; i < nparams; ++i) {
343 v = caml_alloc_tuple (2); Store_field (rv, i, v);
344 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
345 switch (params[i].type) {
346 case VIR_DOMAIN_SCHED_FIELD_INT:
347 v2 = caml_alloc (1, 0);
348 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
350 case VIR_DOMAIN_SCHED_FIELD_UINT:
351 v2 = caml_alloc (1, 1);
352 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
354 case VIR_DOMAIN_SCHED_FIELD_LLONG:
355 v2 = caml_alloc (1, 2);
356 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
358 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
359 v2 = caml_alloc (1, 3);
360 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
362 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
363 v2 = caml_alloc (1, 4);
364 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
366 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
367 v2 = caml_alloc (1, 5);
368 Store_field (v2, 0, Val_int (params[i].value.b));
371 caml_failwith ((char *)__FUNCTION__);
373 Store_field (v, 1, v2);
377 not_supported ("virDomainGetSchedulerParameters");
381 #ifdef HAVE_WEAK_SYMBOLS
382 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
383 extern int virDomainSetSchedulerParameters (virDomainPtr domain,
384 virSchedParameterPtr params,
386 __attribute__((weak));
391 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
393 #ifdef HAVE_VIRDOMAINSETSCHEDULERPARAMETERS
394 CAMLparam2 (domv, paramsv);
396 virDomainPtr dom = Domain_val (domv);
397 virConnectPtr conn = Connect_domv (domv);
398 int nparams = Wosize_val (paramsv);
399 virSchedParameter params[nparams];
403 for (i = 0; i < nparams; ++i) {
404 v = Field (paramsv, i); /* Points to the two-element tuple. */
405 name = String_val (Field (v, 0));
406 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
407 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
408 v = Field (v, 1); /* Points to the sched_param_value block. */
409 switch (Tag_val (v)) {
411 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
412 params[i].value.i = Int32_val (Field (v, 0));
415 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
416 params[i].value.ui = Int32_val (Field (v, 0));
419 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
420 params[i].value.l = Int64_val (Field (v, 0));
423 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
424 params[i].value.ul = Int64_val (Field (v, 0));
427 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
428 params[i].value.d = Double_val (Field (v, 0));
431 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
432 params[i].value.b = Int_val (Field (v, 0));
435 caml_failwith ((char *)__FUNCTION__);
439 WEAK_SYMBOL_CHECK (virDomainSetSchedulerParameters);
440 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
441 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
443 CAMLreturn (Val_unit);
445 not_supported ("virDomainSetSchedulerParameters");
450 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
452 CAMLparam2 (domv, nvcpusv);
453 virDomainPtr dom = Domain_val (domv);
454 virConnectPtr conn = Connect_domv (domv);
455 int r, nvcpus = Int_val (nvcpusv);
457 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
458 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
460 CAMLreturn (Val_unit);
464 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
466 CAMLparam3 (domv, vcpuv, cpumapv);
467 virDomainPtr dom = Domain_val (domv);
468 virConnectPtr conn = Connect_domv (domv);
469 int maplen = caml_string_length (cpumapv);
470 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
471 int vcpu = Int_val (vcpuv);
474 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
475 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
477 CAMLreturn (Val_unit);
481 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
483 CAMLparam3 (domv, maxinfov, maplenv);
484 CAMLlocal5 (rv, infov, strv, v, v2);
485 virDomainPtr dom = Domain_val (domv);
486 virConnectPtr conn = Connect_domv (domv);
487 int maxinfo = Int_val (maxinfov);
488 int maplen = Int_val (maplenv);
489 virVcpuInfo info[maxinfo];
490 unsigned char cpumaps[maxinfo * maplen];
493 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
494 memset (cpumaps, 0, maxinfo * maplen);
496 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
497 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
499 /* Copy the virVcpuInfo structures. */
500 infov = caml_alloc (maxinfo, 0);
501 for (i = 0; i < maxinfo; ++i) {
502 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
503 Store_field (v2, 0, Val_int (info[i].number));
504 Store_field (v2, 1, Val_int (info[i].state));
505 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
506 Store_field (v2, 3, Val_int (info[i].cpu));
509 /* Copy the bitmap. */
510 strv = caml_alloc_string (maxinfo * maplen);
511 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
513 /* Allocate the tuple and return it. */
514 rv = caml_alloc_tuple (3);
515 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
516 Store_field (rv, 1, infov);
517 Store_field (rv, 2, strv);
522 #ifdef HAVE_WEAK_SYMBOLS
523 #ifdef HAVE_VIRDOMAINGETCPUSTATS
524 extern int virDomainGetCPUStats (virDomainPtr domain,
525 virTypedParameterPtr params,
526 unsigned int nparams,
530 __attribute__((weak));
535 ocaml_libvirt_domain_get_cpu_stats (value domv)
537 #ifdef HAVE_VIRDOMAINGETCPUSTATS
539 CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
541 virDomainPtr dom = Domain_val (domv);
542 virConnectPtr conn = Connect_domv (domv);
543 virTypedParameterPtr params;
544 int r, cpu, ncpus, nparams, i, j, pos;
547 /* get number of pcpus */
548 NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
549 CHECK_ERROR (nr_pcpus < 0, conn, "virDomainGetCPUStats");
551 /* get percpu information */
552 NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
553 CHECK_ERROR (nparams < 0, conn, "virDomainGetCPUStats");
555 if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
556 caml_failwith ("virDomainGetCPUStats: malloc");
558 cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
560 while (cpu < nr_pcpus) {
561 ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
563 NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
564 CHECK_ERROR (r < 0, conn, "virDomainGetCPUStats");
566 for (i = 0; i < ncpus; i++) {
567 /* list of typed_param: single linked list of param_nodes */
568 param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
570 if (params[i * nparams].type == 0) {
571 Store_field(cpustats, cpu + i, param_head);
575 for (j = r - 1; j >= 0; j--) {
576 pos = i * nparams + j;
577 if (params[pos].type == 0)
580 param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
581 Store_field(param_node, 1, param_head);
582 param_head = param_node;
584 typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
585 Store_field(param_node, 0, typed_param);
586 Store_field(typed_param, 0, caml_copy_string(params[pos].field));
588 /* typed_param_value: value with the corresponding type tag */
589 switch(params[pos].type) {
590 case VIR_TYPED_PARAM_INT:
591 typed_param_value = caml_alloc (1, 0);
592 v = caml_copy_int32 (params[pos].value.i);
594 case VIR_TYPED_PARAM_UINT:
595 typed_param_value = caml_alloc (1, 1);
596 v = caml_copy_int32 (params[pos].value.ui);
598 case VIR_TYPED_PARAM_LLONG:
599 typed_param_value = caml_alloc (1, 2);
600 v = caml_copy_int64 (params[pos].value.l);
602 case VIR_TYPED_PARAM_ULLONG:
603 typed_param_value = caml_alloc (1, 3);
604 v = caml_copy_int64 (params[pos].value.ul);
606 case VIR_TYPED_PARAM_DOUBLE:
607 typed_param_value = caml_alloc (1, 4);
608 v = caml_copy_double (params[pos].value.d);
610 case VIR_TYPED_PARAM_BOOLEAN:
611 typed_param_value = caml_alloc (1, 5);
612 v = Val_bool (params[pos].value.b);
614 case VIR_TYPED_PARAM_STRING:
615 typed_param_value = caml_alloc (1, 6);
616 v = caml_copy_string (params[pos].value.s);
617 free (params[pos].value.s);
620 /* XXX Memory leak on this path, if there are more
621 * VIR_TYPED_PARAM_STRING past this point in the array.
624 caml_failwith ("virDomainGetCPUStats: "
625 "unknown parameter type returned");
627 Store_field (typed_param_value, 0, v);
628 Store_field (typed_param, 1, typed_param_value);
630 Store_field (cpustats, cpu + i, param_head);
635 CAMLreturn (cpustats);
637 not_supported ("virDomainGetCPUStats");
641 #ifdef HAVE_WEAK_SYMBOLS
642 #ifdef HAVE_VIRDOMAINMIGRATE
643 extern virDomainPtr virDomainMigrate (virDomainPtr domain, virConnectPtr dconn,
644 unsigned long flags, const char *dname,
645 const char *uri, unsigned long bandwidth)
646 __attribute__((weak));
651 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
653 #ifdef HAVE_VIRDOMAINMIGRATE
654 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
655 CAMLxparam2 (optbandwidthv, unitv);
656 CAMLlocal2 (flagv, rv);
657 virDomainPtr dom = Domain_val (domv);
658 virConnectPtr conn = Connect_domv (domv);
659 virConnectPtr dconn = Connect_val (dconnv);
661 const char *dname = Optstring_val (optdnamev);
662 const char *uri = Optstring_val (opturiv);
663 unsigned long bandwidth;
666 /* Iterate over the list of flags. */
667 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
669 flagv = Field (flagsv, 0);
670 if (flagv == Val_int (0))
671 flags |= VIR_MIGRATE_LIVE;
674 if (optbandwidthv == Val_int (0)) /* None */
676 else /* Some bandwidth */
677 bandwidth = Int_val (Field (optbandwidthv, 0));
679 WEAK_SYMBOL_CHECK (virDomainMigrate);
680 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
681 CHECK_ERROR (!r, conn, "virDomainMigrate");
683 rv = Val_domain (r, dconnv);
687 #else /* virDomainMigrate not supported */
688 not_supported ("virDomainMigrate");
693 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
695 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
696 argv[3], argv[4], argv[5],
700 #ifdef HAVE_WEAK_SYMBOLS
701 #ifdef HAVE_VIRDOMAINBLOCKSTATS
702 extern int virDomainBlockStats (virDomainPtr dom,
704 virDomainBlockStatsPtr stats,
706 __attribute__((weak));
711 ocaml_libvirt_domain_block_stats (value domv, value pathv)
713 #if HAVE_VIRDOMAINBLOCKSTATS
714 CAMLparam2 (domv, pathv);
716 virDomainPtr dom = Domain_val (domv);
717 virConnectPtr conn = Connect_domv (domv);
718 char *path = String_val (pathv);
719 struct _virDomainBlockStats stats;
722 WEAK_SYMBOL_CHECK (virDomainBlockStats);
723 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
724 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
726 rv = caml_alloc (5, 0);
727 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
728 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
729 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
730 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
731 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
735 not_supported ("virDomainBlockStats");
739 #ifdef HAVE_WEAK_SYMBOLS
740 #ifdef HAVE_VIRDOMAININTERFACESTATS
741 extern int virDomainInterfaceStats (virDomainPtr dom,
743 virDomainInterfaceStatsPtr stats,
745 __attribute__((weak));
750 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
752 #if HAVE_VIRDOMAININTERFACESTATS
753 CAMLparam2 (domv, pathv);
755 virDomainPtr dom = Domain_val (domv);
756 virConnectPtr conn = Connect_domv (domv);
757 char *path = String_val (pathv);
758 struct _virDomainInterfaceStats stats;
761 WEAK_SYMBOL_CHECK (virDomainInterfaceStats);
762 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
763 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
765 rv = caml_alloc (8, 0);
766 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
767 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
768 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
769 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
770 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
771 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
772 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
773 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
777 not_supported ("virDomainInterfaceStats");
781 #ifdef HAVE_WEAK_SYMBOLS
782 #ifdef HAVE_VIRDOMAINBLOCKPEEK
783 extern int virDomainBlockPeek (virDomainPtr domain,
785 unsigned long long offset,
789 __attribute__((weak));
794 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
796 #ifdef HAVE_VIRDOMAINBLOCKPEEK
797 CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
799 virDomainPtr dom = Domain_val (domv);
800 virConnectPtr conn = Connect_domv (domv);
801 const char *path = String_val (pathv);
802 unsigned long long offset = Int64_val (offsetv);
803 size_t size = Int_val (sizev);
804 char *buffer = String_val (bufferv);
805 int boff = Int_val (boffv);
808 /* Check that the return buffer is big enough. */
809 if (caml_string_length (bufferv) < boff + size)
810 caml_failwith ("virDomainBlockPeek: return buffer too short");
812 WEAK_SYMBOL_CHECK (virDomainBlockPeek);
813 /* NB. not NONBLOCKING because buffer might move (XXX) */
814 r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
815 CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
817 CAMLreturn (Val_unit);
819 #else /* virDomainBlockPeek not supported */
820 not_supported ("virDomainBlockPeek");
825 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
827 return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
828 argv[3], argv[4], argv[5]);
831 #ifdef HAVE_WEAK_SYMBOLS
832 #ifdef HAVE_VIRDOMAINMEMORYPEEK
833 extern int virDomainMemoryPeek (virDomainPtr domain,
834 unsigned long long start,
838 __attribute__((weak));
843 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
845 #ifdef HAVE_VIRDOMAINMEMORYPEEK
846 CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
849 virDomainPtr dom = Domain_val (domv);
850 virConnectPtr conn = Connect_domv (domv);
852 unsigned long long offset = Int64_val (offsetv);
853 size_t size = Int_val (sizev);
854 char *buffer = String_val (bufferv);
855 int boff = Int_val (boffv);
858 /* Check that the return buffer is big enough. */
859 if (caml_string_length (bufferv) < boff + size)
860 caml_failwith ("virDomainMemoryPeek: return buffer too short");
863 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
865 flagv = Field (flagsv, 0);
866 if (flagv == Val_int (0))
867 flags |= VIR_MEMORY_VIRTUAL;
870 WEAK_SYMBOL_CHECK (virDomainMemoryPeek);
871 /* NB. not NONBLOCKING because buffer might move (XXX) */
872 r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
873 CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
875 CAMLreturn (Val_unit);
877 #else /* virDomainMemoryPeek not supported */
878 not_supported ("virDomainMemoryPeek");
883 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
885 return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
886 argv[3], argv[4], argv[5]);
889 #ifdef HAVE_WEAK_SYMBOLS
890 #ifdef HAVE_VIRSTORAGEPOOLGETINFO
891 extern int virStoragePoolGetInfo(virStoragePoolPtr pool, virStoragePoolInfoPtr info)
892 __attribute__((weak));
897 ocaml_libvirt_storage_pool_get_info (value poolv)
899 #if HAVE_VIRSTORAGEPOOLGETINFO
902 virStoragePoolPtr pool = Pool_val (poolv);
903 virConnectPtr conn = Connect_polv (poolv);
904 virStoragePoolInfo info;
907 WEAK_SYMBOL_CHECK (virStoragePoolGetInfo);
908 NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
909 CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo");
911 rv = caml_alloc (4, 0);
912 Store_field (rv, 0, Val_int (info.state));
913 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
914 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
915 v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
919 not_supported ("virStoragePoolGetInfo");
923 #ifdef HAVE_WEAK_SYMBOLS
924 #ifdef HAVE_VIRSTORAGEVOLGETINFO
925 extern int virStorageVolGetInfo(virStorageVolPtr vol, virStorageVolInfoPtr info)
926 __attribute__((weak));
931 ocaml_libvirt_storage_vol_get_info (value volv)
933 #if HAVE_VIRSTORAGEVOLGETINFO
936 virStorageVolPtr vol = Volume_val (volv);
937 virConnectPtr conn = Connect_volv (volv);
938 virStorageVolInfo info;
941 WEAK_SYMBOL_CHECK (virStorageVolGetInfo);
942 NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
943 CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo");
945 rv = caml_alloc (3, 0);
946 Store_field (rv, 0, Val_int (info.type));
947 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
948 v = caml_copy_int64 (info.allocation); Store_field (rv, 1, v);
952 not_supported ("virStorageVolGetInfo");
956 /*----------------------------------------------------------------------*/
959 ocaml_libvirt_virterror_get_last_error (value unitv)
963 virErrorPtr err = virGetLastError ();
965 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
971 ocaml_libvirt_virterror_get_last_conn_error (value connv)
975 virConnectPtr conn = Connect_val (connv);
977 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
983 ocaml_libvirt_virterror_reset_last_error (value unitv)
986 virResetLastError ();
987 CAMLreturn (Val_unit);
991 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
994 virConnectPtr conn = Connect_val (connv);
995 virConnResetLastError (conn);
996 CAMLreturn (Val_unit);
999 /*----------------------------------------------------------------------*/
1001 /* Initialise the library. */
1003 ocaml_libvirt_init (value unit)
1009 r = virInitialize ();
1010 CHECK_ERROR (r == -1, NULL, "virInitialize");
1012 CAMLreturn (Val_unit);