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));
133 ocaml_libvirt_connect_node_get_free_memory (value connv)
137 virConnectPtr conn = Connect_val (connv);
138 unsigned long long r;
140 NONBLOCKING (r = virNodeGetFreeMemory (conn));
141 CHECK_ERROR (r == 0, conn, "virNodeGetFreeMemory");
143 rv = caml_copy_int64 ((int64) r);
148 ocaml_libvirt_connect_node_get_cells_free_memory (value connv,
149 value startv, value maxv)
151 CAMLparam3 (connv, startv, maxv);
153 virConnectPtr conn = Connect_val (connv);
154 int start = Int_val (startv);
155 int max = Int_val (maxv);
157 unsigned long long freemems[max];
159 NONBLOCKING (r = virNodeGetCellsFreeMemory (conn, freemems, start, max));
160 CHECK_ERROR (r == -1, conn, "virNodeGetCellsFreeMemory");
162 rv = caml_alloc (r, 0);
163 for (i = 0; i < r; ++i) {
164 iv = caml_copy_int64 ((int64) freemems[i]);
165 Store_field (rv, i, iv);
172 ocaml_libvirt_connect_set_keep_alive(value connv,
173 value intervalv, value countv)
175 CAMLparam3 (connv, intervalv, countv);
176 virConnectPtr conn = Connect_val(connv);
177 int interval = Int_val(intervalv);
178 unsigned int count = Int_val(countv);
181 NONBLOCKING(r = virConnectSetKeepAlive(conn, interval, count));
182 CHECK_ERROR (r == -1, conn, "virConnectSetKeepAlive");
184 CAMLreturn(Val_unit);
189 ocaml_libvirt_domain_get_id (value domv)
192 virDomainPtr dom = Domain_val (domv);
193 /*virConnectPtr conn = Connect_domv (domv);*/
196 NONBLOCKING (r = virDomainGetID (dom));
197 /* In theory this could return -1 on error, but in practice
198 * libvirt never does this unless you call it with a corrupted
199 * or NULL dom object. So ignore errors here.
202 CAMLreturn (Val_int ((int) r));
206 ocaml_libvirt_domain_get_max_memory (value domv)
210 virDomainPtr dom = Domain_val (domv);
211 virConnectPtr conn = Connect_domv (domv);
214 NONBLOCKING (r = virDomainGetMaxMemory (dom));
215 CHECK_ERROR (r == 0 /* [sic] */, conn, "virDomainGetMaxMemory");
217 rv = caml_copy_int64 (r);
222 ocaml_libvirt_domain_set_max_memory (value domv, value memv)
224 CAMLparam2 (domv, memv);
225 virDomainPtr dom = Domain_val (domv);
226 virConnectPtr conn = Connect_domv (domv);
227 unsigned long mem = Int64_val (memv);
230 NONBLOCKING (r = virDomainSetMaxMemory (dom, mem));
231 CHECK_ERROR (r == -1, conn, "virDomainSetMaxMemory");
233 CAMLreturn (Val_unit);
237 ocaml_libvirt_domain_set_memory (value domv, value memv)
239 CAMLparam2 (domv, memv);
240 virDomainPtr dom = Domain_val (domv);
241 virConnectPtr conn = Connect_domv (domv);
242 unsigned long mem = Int64_val (memv);
245 NONBLOCKING (r = virDomainSetMemory (dom, mem));
246 CHECK_ERROR (r == -1, conn, "virDomainSetMemory");
248 CAMLreturn (Val_unit);
252 ocaml_libvirt_domain_get_info (value domv)
256 virDomainPtr dom = Domain_val (domv);
257 virConnectPtr conn = Connect_domv (domv);
261 NONBLOCKING (r = virDomainGetInfo (dom, &info));
262 CHECK_ERROR (r == -1, conn, "virDomainGetInfo");
264 rv = caml_alloc (5, 0);
265 Store_field (rv, 0, Val_int (info.state)); // These flags are compatible.
266 v = caml_copy_int64 (info.maxMem); Store_field (rv, 1, v);
267 v = caml_copy_int64 (info.memory); Store_field (rv, 2, v);
268 Store_field (rv, 3, Val_int (info.nrVirtCpu));
269 v = caml_copy_int64 (info.cpuTime); Store_field (rv, 4, v);
275 ocaml_libvirt_domain_get_scheduler_type (value domv)
278 CAMLlocal2 (rv, strv);
279 virDomainPtr dom = Domain_val (domv);
280 virConnectPtr conn = Connect_domv (domv);
284 NONBLOCKING (r = virDomainGetSchedulerType (dom, &nparams));
285 CHECK_ERROR (!r, conn, "virDomainGetSchedulerType");
287 rv = caml_alloc_tuple (2);
288 strv = caml_copy_string (r); Store_field (rv, 0, strv);
290 Store_field (rv, 1, nparams);
295 ocaml_libvirt_domain_get_scheduler_parameters (value domv, value nparamsv)
297 CAMLparam2 (domv, nparamsv);
298 CAMLlocal4 (rv, v, v2, v3);
299 virDomainPtr dom = Domain_val (domv);
300 virConnectPtr conn = Connect_domv (domv);
301 int nparams = Int_val (nparamsv);
302 virSchedParameter params[nparams];
305 NONBLOCKING (r = virDomainGetSchedulerParameters (dom, params, &nparams));
306 CHECK_ERROR (r == -1, conn, "virDomainGetSchedulerParameters");
308 rv = caml_alloc (nparams, 0);
309 for (i = 0; i < nparams; ++i) {
310 v = caml_alloc_tuple (2); Store_field (rv, i, v);
311 v2 = caml_copy_string (params[i].field); Store_field (v, 0, v2);
312 switch (params[i].type) {
313 case VIR_DOMAIN_SCHED_FIELD_INT:
314 v2 = caml_alloc (1, 0);
315 v3 = caml_copy_int32 (params[i].value.i); Store_field (v2, 0, v3);
317 case VIR_DOMAIN_SCHED_FIELD_UINT:
318 v2 = caml_alloc (1, 1);
319 v3 = caml_copy_int32 (params[i].value.ui); Store_field (v2, 0, v3);
321 case VIR_DOMAIN_SCHED_FIELD_LLONG:
322 v2 = caml_alloc (1, 2);
323 v3 = caml_copy_int64 (params[i].value.l); Store_field (v2, 0, v3);
325 case VIR_DOMAIN_SCHED_FIELD_ULLONG:
326 v2 = caml_alloc (1, 3);
327 v3 = caml_copy_int64 (params[i].value.ul); Store_field (v2, 0, v3);
329 case VIR_DOMAIN_SCHED_FIELD_DOUBLE:
330 v2 = caml_alloc (1, 4);
331 v3 = caml_copy_double (params[i].value.d); Store_field (v2, 0, v3);
333 case VIR_DOMAIN_SCHED_FIELD_BOOLEAN:
334 v2 = caml_alloc (1, 5);
335 Store_field (v2, 0, Val_int (params[i].value.b));
338 caml_failwith ((char *)__FUNCTION__);
340 Store_field (v, 1, v2);
346 ocaml_libvirt_domain_set_scheduler_parameters (value domv, value paramsv)
348 CAMLparam2 (domv, paramsv);
350 virDomainPtr dom = Domain_val (domv);
351 virConnectPtr conn = Connect_domv (domv);
352 int nparams = Wosize_val (paramsv);
353 virSchedParameter params[nparams];
357 for (i = 0; i < nparams; ++i) {
358 v = Field (paramsv, i); /* Points to the two-element tuple. */
359 name = String_val (Field (v, 0));
360 strncpy (params[i].field, name, VIR_DOMAIN_SCHED_FIELD_LENGTH);
361 params[i].field[VIR_DOMAIN_SCHED_FIELD_LENGTH-1] = '\0';
362 v = Field (v, 1); /* Points to the sched_param_value block. */
363 switch (Tag_val (v)) {
365 params[i].type = VIR_DOMAIN_SCHED_FIELD_INT;
366 params[i].value.i = Int32_val (Field (v, 0));
369 params[i].type = VIR_DOMAIN_SCHED_FIELD_UINT;
370 params[i].value.ui = Int32_val (Field (v, 0));
373 params[i].type = VIR_DOMAIN_SCHED_FIELD_LLONG;
374 params[i].value.l = Int64_val (Field (v, 0));
377 params[i].type = VIR_DOMAIN_SCHED_FIELD_ULLONG;
378 params[i].value.ul = Int64_val (Field (v, 0));
381 params[i].type = VIR_DOMAIN_SCHED_FIELD_DOUBLE;
382 params[i].value.d = Double_val (Field (v, 0));
385 params[i].type = VIR_DOMAIN_SCHED_FIELD_BOOLEAN;
386 params[i].value.b = Int_val (Field (v, 0));
389 caml_failwith ((char *)__FUNCTION__);
393 NONBLOCKING (r = virDomainSetSchedulerParameters (dom, params, nparams));
394 CHECK_ERROR (r == -1, conn, "virDomainSetSchedulerParameters");
396 CAMLreturn (Val_unit);
400 ocaml_libvirt_domain_set_vcpus (value domv, value nvcpusv)
402 CAMLparam2 (domv, nvcpusv);
403 virDomainPtr dom = Domain_val (domv);
404 virConnectPtr conn = Connect_domv (domv);
405 int r, nvcpus = Int_val (nvcpusv);
407 NONBLOCKING (r = virDomainSetVcpus (dom, nvcpus));
408 CHECK_ERROR (r == -1, conn, "virDomainSetVcpus");
410 CAMLreturn (Val_unit);
414 ocaml_libvirt_domain_pin_vcpu (value domv, value vcpuv, value cpumapv)
416 CAMLparam3 (domv, vcpuv, cpumapv);
417 virDomainPtr dom = Domain_val (domv);
418 virConnectPtr conn = Connect_domv (domv);
419 int maplen = caml_string_length (cpumapv);
420 unsigned char *cpumap = (unsigned char *) String_val (cpumapv);
421 int vcpu = Int_val (vcpuv);
424 NONBLOCKING (r = virDomainPinVcpu (dom, vcpu, cpumap, maplen));
425 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
427 CAMLreturn (Val_unit);
431 ocaml_libvirt_domain_get_vcpus (value domv, value maxinfov, value maplenv)
433 CAMLparam3 (domv, maxinfov, maplenv);
434 CAMLlocal5 (rv, infov, strv, v, v2);
435 virDomainPtr dom = Domain_val (domv);
436 virConnectPtr conn = Connect_domv (domv);
437 int maxinfo = Int_val (maxinfov);
438 int maplen = Int_val (maplenv);
439 virVcpuInfo info[maxinfo];
440 unsigned char cpumaps[maxinfo * maplen];
443 memset (info, 0, sizeof (virVcpuInfo) * maxinfo);
444 memset (cpumaps, 0, maxinfo * maplen);
446 NONBLOCKING (r = virDomainGetVcpus (dom, info, maxinfo, cpumaps, maplen));
447 CHECK_ERROR (r == -1, conn, "virDomainPinVcpu");
449 /* Copy the virVcpuInfo structures. */
450 infov = caml_alloc (maxinfo, 0);
451 for (i = 0; i < maxinfo; ++i) {
452 v2 = caml_alloc (4, 0); Store_field (infov, i, v2);
453 Store_field (v2, 0, Val_int (info[i].number));
454 Store_field (v2, 1, Val_int (info[i].state));
455 v = caml_copy_int64 (info[i].cpuTime); Store_field (v2, 2, v);
456 Store_field (v2, 3, Val_int (info[i].cpu));
459 /* Copy the bitmap. */
460 strv = caml_alloc_string (maxinfo * maplen);
461 memcpy (String_val (strv), cpumaps, maxinfo * maplen);
463 /* Allocate the tuple and return it. */
464 rv = caml_alloc_tuple (3);
465 Store_field (rv, 0, Val_int (r)); /* number of CPUs. */
466 Store_field (rv, 1, infov);
467 Store_field (rv, 2, strv);
473 ocaml_libvirt_domain_get_cpu_stats (value domv)
476 CAMLlocal5 (cpustats, param_head, param_node, typed_param, typed_param_value);
478 virDomainPtr dom = Domain_val (domv);
479 virConnectPtr conn = Connect_domv (domv);
480 virTypedParameterPtr params;
481 int r, cpu, ncpus, nparams, i, j, pos;
484 /* get number of pcpus */
485 NONBLOCKING (nr_pcpus = virDomainGetCPUStats(dom, NULL, 0, 0, 0, 0));
486 CHECK_ERROR (nr_pcpus < 0, conn, "virDomainGetCPUStats");
488 /* get percpu information */
489 NONBLOCKING (nparams = virDomainGetCPUStats(dom, NULL, 0, 0, 1, 0));
490 CHECK_ERROR (nparams < 0, conn, "virDomainGetCPUStats");
492 if ((params = malloc(sizeof(*params) * nparams * 128)) == NULL)
493 caml_failwith ("virDomainGetCPUStats: malloc");
495 cpustats = caml_alloc (nr_pcpus, 0); /* cpustats: array of params(list of typed_param) */
497 while (cpu < nr_pcpus) {
498 ncpus = nr_pcpus - cpu > 128 ? 128 : nr_pcpus - cpu;
500 NONBLOCKING (r = virDomainGetCPUStats(dom, params, nparams, cpu, ncpus, 0));
501 CHECK_ERROR (r < 0, conn, "virDomainGetCPUStats");
503 for (i = 0; i < ncpus; i++) {
504 /* list of typed_param: single linked list of param_nodes */
505 param_head = Val_emptylist; /* param_head: the head param_node of list of typed_param */
507 if (params[i * nparams].type == 0) {
508 Store_field(cpustats, cpu + i, param_head);
512 for (j = r - 1; j >= 0; j--) {
513 pos = i * nparams + j;
514 if (params[pos].type == 0)
517 param_node = caml_alloc(2, 0); /* param_node: typed_param, next param_node */
518 Store_field(param_node, 1, param_head);
519 param_head = param_node;
521 typed_param = caml_alloc(2, 0); /* typed_param: field name(string), typed_param_value */
522 Store_field(param_node, 0, typed_param);
523 Store_field(typed_param, 0, caml_copy_string(params[pos].field));
525 /* typed_param_value: value with the corresponding type tag */
526 switch(params[pos].type) {
527 case VIR_TYPED_PARAM_INT:
528 typed_param_value = caml_alloc (1, 0);
529 v = caml_copy_int32 (params[pos].value.i);
531 case VIR_TYPED_PARAM_UINT:
532 typed_param_value = caml_alloc (1, 1);
533 v = caml_copy_int32 (params[pos].value.ui);
535 case VIR_TYPED_PARAM_LLONG:
536 typed_param_value = caml_alloc (1, 2);
537 v = caml_copy_int64 (params[pos].value.l);
539 case VIR_TYPED_PARAM_ULLONG:
540 typed_param_value = caml_alloc (1, 3);
541 v = caml_copy_int64 (params[pos].value.ul);
543 case VIR_TYPED_PARAM_DOUBLE:
544 typed_param_value = caml_alloc (1, 4);
545 v = caml_copy_double (params[pos].value.d);
547 case VIR_TYPED_PARAM_BOOLEAN:
548 typed_param_value = caml_alloc (1, 5);
549 v = Val_bool (params[pos].value.b);
551 case VIR_TYPED_PARAM_STRING:
552 typed_param_value = caml_alloc (1, 6);
553 v = caml_copy_string (params[pos].value.s);
554 free (params[pos].value.s);
557 /* XXX Memory leak on this path, if there are more
558 * VIR_TYPED_PARAM_STRING past this point in the array.
561 caml_failwith ("virDomainGetCPUStats: "
562 "unknown parameter type returned");
564 Store_field (typed_param_value, 0, v);
565 Store_field (typed_param, 1, typed_param_value);
567 Store_field (cpustats, cpu + i, param_head);
572 CAMLreturn (cpustats);
576 ocaml_libvirt_domain_migrate_native (value domv, value dconnv, value flagsv, value optdnamev, value opturiv, value optbandwidthv, value unitv)
578 CAMLparam5 (domv, dconnv, flagsv, optdnamev, opturiv);
579 CAMLxparam2 (optbandwidthv, unitv);
580 CAMLlocal2 (flagv, rv);
581 virDomainPtr dom = Domain_val (domv);
582 virConnectPtr conn = Connect_domv (domv);
583 virConnectPtr dconn = Connect_val (dconnv);
585 const char *dname = Optstring_val (optdnamev);
586 const char *uri = Optstring_val (opturiv);
587 unsigned long bandwidth;
590 /* Iterate over the list of flags. */
591 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
593 flagv = Field (flagsv, 0);
594 if (flagv == Val_int (0))
595 flags |= VIR_MIGRATE_LIVE;
598 if (optbandwidthv == Val_int (0)) /* None */
600 else /* Some bandwidth */
601 bandwidth = Int_val (Field (optbandwidthv, 0));
603 NONBLOCKING (r = virDomainMigrate (dom, dconn, flags, dname, uri, bandwidth));
604 CHECK_ERROR (!r, conn, "virDomainMigrate");
606 rv = Val_domain (r, dconnv);
612 ocaml_libvirt_domain_migrate_bytecode (value *argv, int argn)
614 return ocaml_libvirt_domain_migrate_native (argv[0], argv[1], argv[2],
615 argv[3], argv[4], argv[5],
620 ocaml_libvirt_domain_block_stats (value domv, value pathv)
622 CAMLparam2 (domv, pathv);
624 virDomainPtr dom = Domain_val (domv);
625 virConnectPtr conn = Connect_domv (domv);
626 char *path = String_val (pathv);
627 struct _virDomainBlockStats stats;
630 NONBLOCKING (r = virDomainBlockStats (dom, path, &stats, sizeof stats));
631 CHECK_ERROR (r == -1, conn, "virDomainBlockStats");
633 rv = caml_alloc (5, 0);
634 v = caml_copy_int64 (stats.rd_req); Store_field (rv, 0, v);
635 v = caml_copy_int64 (stats.rd_bytes); Store_field (rv, 1, v);
636 v = caml_copy_int64 (stats.wr_req); Store_field (rv, 2, v);
637 v = caml_copy_int64 (stats.wr_bytes); Store_field (rv, 3, v);
638 v = caml_copy_int64 (stats.errs); Store_field (rv, 4, v);
644 ocaml_libvirt_domain_interface_stats (value domv, value pathv)
646 CAMLparam2 (domv, pathv);
648 virDomainPtr dom = Domain_val (domv);
649 virConnectPtr conn = Connect_domv (domv);
650 char *path = String_val (pathv);
651 struct _virDomainInterfaceStats stats;
654 NONBLOCKING (r = virDomainInterfaceStats (dom, path, &stats, sizeof stats));
655 CHECK_ERROR (r == -1, conn, "virDomainInterfaceStats");
657 rv = caml_alloc (8, 0);
658 v = caml_copy_int64 (stats.rx_bytes); Store_field (rv, 0, v);
659 v = caml_copy_int64 (stats.rx_packets); Store_field (rv, 1, v);
660 v = caml_copy_int64 (stats.rx_errs); Store_field (rv, 2, v);
661 v = caml_copy_int64 (stats.rx_drop); Store_field (rv, 3, v);
662 v = caml_copy_int64 (stats.tx_bytes); Store_field (rv, 4, v);
663 v = caml_copy_int64 (stats.tx_packets); Store_field (rv, 5, v);
664 v = caml_copy_int64 (stats.tx_errs); Store_field (rv, 6, v);
665 v = caml_copy_int64 (stats.tx_drop); Store_field (rv, 7, v);
671 ocaml_libvirt_domain_block_peek_native (value domv, value pathv, value offsetv, value sizev, value bufferv, value boffv)
673 CAMLparam5 (domv, pathv, offsetv, sizev, bufferv);
675 virDomainPtr dom = Domain_val (domv);
676 virConnectPtr conn = Connect_domv (domv);
677 const char *path = String_val (pathv);
678 unsigned long long offset = Int64_val (offsetv);
679 size_t size = Int_val (sizev);
680 char *buffer = String_val (bufferv);
681 int boff = Int_val (boffv);
684 /* Check that the return buffer is big enough. */
685 if (caml_string_length (bufferv) < boff + size)
686 caml_failwith ("virDomainBlockPeek: return buffer too short");
688 /* NB. not NONBLOCKING because buffer might move (XXX) */
689 r = virDomainBlockPeek (dom, path, offset, size, buffer+boff, 0);
690 CHECK_ERROR (r == -1, conn, "virDomainBlockPeek");
692 CAMLreturn (Val_unit);
696 ocaml_libvirt_domain_block_peek_bytecode (value *argv, int argn)
698 return ocaml_libvirt_domain_block_peek_native (argv[0], argv[1], argv[2],
699 argv[3], argv[4], argv[5]);
703 ocaml_libvirt_domain_memory_peek_native (value domv, value flagsv, value offsetv, value sizev, value bufferv, value boffv)
705 CAMLparam5 (domv, flagsv, offsetv, sizev, bufferv);
708 virDomainPtr dom = Domain_val (domv);
709 virConnectPtr conn = Connect_domv (domv);
711 unsigned long long offset = Int64_val (offsetv);
712 size_t size = Int_val (sizev);
713 char *buffer = String_val (bufferv);
714 int boff = Int_val (boffv);
717 /* Check that the return buffer is big enough. */
718 if (caml_string_length (bufferv) < boff + size)
719 caml_failwith ("virDomainMemoryPeek: return buffer too short");
722 for (; flagsv != Val_int (0); flagsv = Field (flagsv, 1))
724 flagv = Field (flagsv, 0);
725 if (flagv == Val_int (0))
726 flags |= VIR_MEMORY_VIRTUAL;
729 /* NB. not NONBLOCKING because buffer might move (XXX) */
730 r = virDomainMemoryPeek (dom, offset, size, buffer+boff, flags);
731 CHECK_ERROR (r == -1, conn, "virDomainMemoryPeek");
733 CAMLreturn (Val_unit);
737 ocaml_libvirt_domain_memory_peek_bytecode (value *argv, int argn)
739 return ocaml_libvirt_domain_memory_peek_native (argv[0], argv[1], argv[2],
740 argv[3], argv[4], argv[5]);
743 /*----------------------------------------------------------------------*/
748 ocaml_libvirt_event_register_default_impl (value unitv)
752 /* arg is of type unit = void */
755 NONBLOCKING (r = virEventRegisterDefaultImpl ());
756 /* must be called before connection, therefore we can't use CHECK_ERROR */
757 if (r == -1) caml_failwith("virEventRegisterDefaultImpl");
759 CAMLreturn (Val_unit);
763 ocaml_libvirt_event_run_default_impl (value unitv)
767 /* arg is of type unit = void */
770 NONBLOCKING (r = virEventRunDefaultImpl ());
771 if (r == -1) caml_failwith("virEventRunDefaultImpl");
773 CAMLreturn (Val_unit);
776 /* We register a single C callback function for every distinct
777 callback signature. We encode the signature itself in the function
778 name and also in the name of the assocated OCaml callback
781 i_i64_s_callback(virConnectPtr conn,
787 would correspond to an OCaml callback
788 Libvirt.i_i64_s_callback :
789 int64 -> [`R] Domain.t -> int -> int64 -> string option -> unit
790 where the initial int64 is a unique ID used by the OCaml to
791 dispatch to the specific OCaml closure and stored by libvirt
792 as the "opaque" data. */
794 /* Every one of the callbacks starts with a DOMAIN_CALLBACK_BEGIN(NAME)
795 where NAME is the string name of the OCaml callback registered
797 #define DOMAIN_CALLBACK_BEGIN(NAME) \
798 value connv, domv, callback_id, result; \
799 connv = domv = callback_id = result = Val_int(0); \
800 static value *callback = NULL; \
801 caml_leave_blocking_section(); \
802 if (callback == NULL) \
803 callback = caml_named_value(NAME); \
804 if (callback == NULL) \
805 abort(); /* C code out of sync with OCaml code */ \
806 if ((virDomainRef(dom) == -1) || (virConnectRef(conn) == -1)) \
807 abort(); /* should never happen in practice? */ \
809 Begin_roots4(connv, domv, callback_id, result); \
810 connv = Val_connect(conn); \
811 domv = Val_domain(dom, connv); \
812 callback_id = caml_copy_int64(*(long *)opaque);
814 /* Every one of the callbacks ends with a CALLBACK_END */
815 #define DOMAIN_CALLBACK_END \
816 (void) caml_callback3(*callback, callback_id, domv, result); \
818 caml_enter_blocking_section();
822 i_i_callback(virConnectPtr conn,
828 DOMAIN_CALLBACK_BEGIN("Libvirt.i_i_callback")
829 result = caml_alloc_tuple(2);
830 Store_field(result, 0, Val_int(x));
831 Store_field(result, 1, Val_int(y));
836 u_callback(virConnectPtr conn,
840 DOMAIN_CALLBACK_BEGIN("Libvirt.u_callback")
841 result = Val_int(0); /* () */
846 i64_callback(virConnectPtr conn,
851 DOMAIN_CALLBACK_BEGIN("Libvirt.i64_callback")
852 result = caml_copy_int64(int64);
857 i_callback(virConnectPtr conn,
862 DOMAIN_CALLBACK_BEGIN("Libvirt.i_callback")
868 s_i_callback(virConnectPtr conn,
874 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_callback")
875 result = caml_alloc_tuple(2);
876 Store_field(result, 0,
877 Val_opt(x, (Val_ptr_t) caml_copy_string));
878 Store_field(result, 1, Val_int(y));
883 s_i_i_callback(virConnectPtr conn,
890 DOMAIN_CALLBACK_BEGIN("Libvirt.s_i_i_callback")
891 result = caml_alloc_tuple(3);
892 Store_field(result, 0,
893 Val_opt(x, (Val_ptr_t) caml_copy_string));
894 Store_field(result, 1, Val_int(y));
895 Store_field(result, 2, Val_int(z));
900 s_s_i_callback(virConnectPtr conn,
907 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_callback")
908 result = caml_alloc_tuple(3);
909 Store_field(result, 0,
910 Val_opt(x, (Val_ptr_t) caml_copy_string));
911 Store_field(result, 1,
912 Val_opt(y, (Val_ptr_t) caml_copy_string));
913 Store_field(result, 2, Val_int(z));
918 s_s_i_s_callback(virConnectPtr conn,
926 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_i_s_callback")
927 result = caml_alloc_tuple(4);
928 Store_field(result, 0,
929 Val_opt(x, (Val_ptr_t) caml_copy_string));
930 Store_field(result, 1,
931 Val_opt(y, (Val_ptr_t) caml_copy_string));
932 Store_field(result, 2, Val_int(z));
933 Store_field(result, 3,
934 Val_opt(a, (Val_ptr_t) caml_copy_string));
939 s_s_s_i_callback(virConnectPtr conn,
947 DOMAIN_CALLBACK_BEGIN("Libvirt.s_s_s_i_callback")
948 result = caml_alloc_tuple(4);
949 Store_field(result, 0,
950 Val_opt(x, (Val_ptr_t) caml_copy_string));
951 Store_field(result, 1,
952 Val_opt(y, (Val_ptr_t) caml_copy_string));
953 Store_field(result, 2,
954 Val_opt(z, (Val_ptr_t) caml_copy_string));
955 Store_field(result, 3, Val_int(a));
960 Val_event_graphics_address(virDomainEventGraphicsAddressPtr x)
964 result = caml_alloc_tuple(3);
965 Store_field(result, 0, Val_int(x->family));
966 Store_field(result, 1,
967 Val_opt((void *) x->node, (Val_ptr_t) caml_copy_string));
968 Store_field(result, 2,
969 Val_opt((void *) x->service, (Val_ptr_t) caml_copy_string));
974 Val_event_graphics_subject_identity(virDomainEventGraphicsSubjectIdentityPtr x)
978 result = caml_alloc_tuple(2);
979 Store_field(result, 0,
980 Val_opt((void *) x->type, (Val_ptr_t) caml_copy_string));
981 Store_field(result, 1,
982 Val_opt((void *) x->name, (Val_ptr_t) caml_copy_string));
988 Val_event_graphics_subject(virDomainEventGraphicsSubjectPtr x)
993 result = caml_alloc_tuple(x->nidentity);
994 for (i = 0; i < x->nidentity; i++ )
995 Store_field(result, i,
996 Val_event_graphics_subject_identity(x->identities + i));
1001 i_ga_ga_s_gs_callback(virConnectPtr conn,
1004 virDomainEventGraphicsAddressPtr ga1,
1005 virDomainEventGraphicsAddressPtr ga2,
1007 virDomainEventGraphicsSubjectPtr gs1,
1010 DOMAIN_CALLBACK_BEGIN("Libvirt.i_ga_ga_s_gs_callback")
1011 result = caml_alloc_tuple(5);
1012 Store_field(result, 0, Val_int(i1));
1013 Store_field(result, 1, Val_event_graphics_address(ga1));
1014 Store_field(result, 2, Val_event_graphics_address(ga2));
1015 Store_field(result, 3,
1016 Val_opt(s1, (Val_ptr_t) caml_copy_string));
1017 Store_field(result, 4, Val_event_graphics_subject(gs1));
1022 timeout_callback(int timer, void *opaque)
1024 value callback_id, result;
1025 callback_id = result = Val_int(0);
1026 static value *callback = NULL;
1027 caml_leave_blocking_section();
1028 if (callback == NULL)
1029 callback = caml_named_value("Libvirt.timeout_callback");
1030 if (callback == NULL)
1031 abort(); /* C code out of sync with OCaml code */
1033 Begin_roots2(callback_id, result);
1034 callback_id = caml_copy_int64(*(long *)opaque);
1036 (void)caml_callback_exn(*callback, callback_id);
1038 caml_enter_blocking_section();
1042 ocaml_libvirt_event_add_timeout (value connv, value ms, value callback_id)
1044 CAMLparam3 (connv, ms, callback_id);
1045 virConnectPtr conn = Connect_val (connv);
1047 virFreeCallback freecb = free;
1048 virEventTimeoutCallback cb = timeout_callback;
1052 /* Store the int64 callback_id as the opaque data so the OCaml
1053 callback can demultiplex to the correct OCaml handler. */
1054 if ((opaque = malloc(sizeof(long))) == NULL)
1055 caml_failwith ("virEventAddTimeout: malloc");
1056 *((long*)opaque) = Int64_val(callback_id);
1057 NONBLOCKING(r = virEventAddTimeout(Int_val(ms), cb, opaque, freecb));
1058 CHECK_ERROR(r == -1, conn, "virEventAddTimeout");
1060 CAMLreturn(Val_int(r));
1064 ocaml_libvirt_event_remove_timeout (value connv, value timer_id)
1066 CAMLparam2 (connv, timer_id);
1067 virConnectPtr conn = Connect_val (connv);
1070 NONBLOCKING(r = virEventRemoveTimeout(Int_val(timer_id)));
1071 CHECK_ERROR(r == -1, conn, "virEventRemoveTimeout");
1073 CAMLreturn(Val_int(r));
1077 ocaml_libvirt_connect_domain_event_register_any(value connv, value domv, value callback, value callback_id)
1079 CAMLparam4(connv, domv, callback, callback_id);
1081 virConnectPtr conn = Connect_val (connv);
1082 virDomainPtr dom = NULL;
1083 int eventID = Tag_val(callback);
1085 virConnectDomainEventGenericCallback cb;
1087 virFreeCallback freecb = free;
1090 if (domv != Val_int(0))
1091 dom = Domain_val (Field(domv, 0));
1094 case VIR_DOMAIN_EVENT_ID_LIFECYCLE:
1095 cb = VIR_DOMAIN_EVENT_CALLBACK(i_i_callback);
1097 case VIR_DOMAIN_EVENT_ID_REBOOT:
1098 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1100 case VIR_DOMAIN_EVENT_ID_RTC_CHANGE:
1101 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1103 case VIR_DOMAIN_EVENT_ID_WATCHDOG:
1104 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1106 case VIR_DOMAIN_EVENT_ID_IO_ERROR:
1107 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_callback);
1109 case VIR_DOMAIN_EVENT_ID_GRAPHICS:
1110 cb = VIR_DOMAIN_EVENT_CALLBACK(i_ga_ga_s_gs_callback);
1112 case VIR_DOMAIN_EVENT_ID_IO_ERROR_REASON:
1113 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_i_s_callback);
1115 case VIR_DOMAIN_EVENT_ID_CONTROL_ERROR:
1116 cb = VIR_DOMAIN_EVENT_CALLBACK(u_callback);
1118 case VIR_DOMAIN_EVENT_ID_BLOCK_JOB:
1119 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_i_callback);
1121 case VIR_DOMAIN_EVENT_ID_DISK_CHANGE:
1122 cb = VIR_DOMAIN_EVENT_CALLBACK(s_s_s_i_callback);
1124 case VIR_DOMAIN_EVENT_ID_TRAY_CHANGE:
1125 cb = VIR_DOMAIN_EVENT_CALLBACK(s_i_callback);
1127 case VIR_DOMAIN_EVENT_ID_PMWAKEUP:
1128 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1130 case VIR_DOMAIN_EVENT_ID_PMSUSPEND:
1131 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1133 case VIR_DOMAIN_EVENT_ID_BALLOON_CHANGE:
1134 cb = VIR_DOMAIN_EVENT_CALLBACK(i64_callback);
1136 case VIR_DOMAIN_EVENT_ID_PMSUSPEND_DISK:
1137 cb = VIR_DOMAIN_EVENT_CALLBACK(i_callback);
1140 caml_failwith("vifConnectDomainEventRegisterAny: unimplemented eventID");
1143 /* Store the int64 callback_id as the opaque data so the OCaml
1144 callback can demultiplex to the correct OCaml handler. */
1145 if ((opaque = malloc(sizeof(long))) == NULL)
1146 caml_failwith ("virConnectDomainEventRegisterAny: malloc");
1147 *((long*)opaque) = Int64_val(callback_id);
1148 NONBLOCKING(r = virConnectDomainEventRegisterAny(conn, dom, eventID, cb, opaque, freecb));
1149 CHECK_ERROR(r == -1, conn, "virConnectDomainEventRegisterAny");
1151 CAMLreturn(Val_int(r));
1155 ocaml_libvirt_storage_pool_get_info (value poolv)
1159 virStoragePoolPtr pool = Pool_val (poolv);
1160 virConnectPtr conn = Connect_polv (poolv);
1161 virStoragePoolInfo info;
1164 NONBLOCKING (r = virStoragePoolGetInfo (pool, &info));
1165 CHECK_ERROR (r == -1, conn, "virStoragePoolGetInfo");
1167 rv = caml_alloc (4, 0);
1168 Store_field (rv, 0, Val_int (info.state));
1169 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1170 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1171 v = caml_copy_int64 (info.available); Store_field (rv, 3, v);
1177 ocaml_libvirt_storage_vol_get_info (value volv)
1181 virStorageVolPtr vol = Volume_val (volv);
1182 virConnectPtr conn = Connect_volv (volv);
1183 virStorageVolInfo info;
1186 NONBLOCKING (r = virStorageVolGetInfo (vol, &info));
1187 CHECK_ERROR (r == -1, conn, "virStorageVolGetInfo");
1189 rv = caml_alloc (3, 0);
1190 Store_field (rv, 0, Val_int (info.type));
1191 v = caml_copy_int64 (info.capacity); Store_field (rv, 1, v);
1192 v = caml_copy_int64 (info.allocation); Store_field (rv, 2, v);
1197 /*----------------------------------------------------------------------*/
1200 ocaml_libvirt_virterror_get_last_error (value unitv)
1204 virErrorPtr err = virGetLastError ();
1206 rv = Val_opt (err, (Val_ptr_t) Val_virterror);
1212 ocaml_libvirt_virterror_get_last_conn_error (value connv)
1216 virConnectPtr conn = Connect_val (connv);
1218 rv = Val_opt (conn, (Val_ptr_t) Val_connect);
1224 ocaml_libvirt_virterror_reset_last_error (value unitv)
1227 virResetLastError ();
1228 CAMLreturn (Val_unit);
1232 ocaml_libvirt_virterror_reset_last_conn_error (value connv)
1235 virConnectPtr conn = Connect_val (connv);
1236 virConnResetLastError (conn);
1237 CAMLreturn (Val_unit);
1240 /*----------------------------------------------------------------------*/
1242 /* Initialise the library. */
1244 ocaml_libvirt_init (value unit)
1250 r = virInitialize ();
1251 CHECK_ERROR (r == -1, NULL, "virInitialize");
1253 CAMLreturn (Val_unit);