3 # OCaml bindings for libvirt.
4 # (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
7 # This library is free software; you can redistribute it and/or
8 # modify it under the terms of the GNU Lesser General Public
9 # License as published by the Free Software Foundation; either
10 # version 2 of the License, or (at your option) any later version.
12 # This library is distributed in the hope that it will be useful,
13 # but WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # Lesser General Public License for more details.
17 # You should have received a copy of the GNU Lesser General Public
18 # License along with this library; if not, write to the Free Software
19 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
21 # This generates libvirt_c.c (the core of the bindings). You don't
22 # need to run this program unless you are extending the bindings
23 # themselves (eg. because libvirt has been extended).
27 #----------------------------------------------------------------------
29 # The functions in the libvirt API that we can generate.
32 { name => "virConnectClose", sig => "conn : free" },
33 { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
34 { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
35 { name => "virConnectGetType", sig => "conn : static string" },
36 { name => "virConnectNumOfDomains", sig => "conn : int" },
37 { name => "virConnectListDomains", sig => "conn, int : int array" },
38 { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
39 { name => "virConnectListDefinedDomains",
40 sig => "conn, int : string array" },
41 { name => "virConnectNumOfNetworks", sig => "conn : int" },
42 { name => "virConnectListNetworks", sig => "conn, int : string array" },
43 { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
44 { name => "virConnectListDefinedNetworks",
45 sig => "conn, int : string array" },
46 { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
47 { name => "virConnectListStoragePools",
48 sig => "conn, int : string array", weak => 1 },
49 { name => "virConnectNumOfDefinedStoragePools",
50 sig => "conn : int", weak => 1 },
51 { name => "virConnectListDefinedStoragePools",
52 sig => "conn, int : string array", weak => 1 },
53 { name => "virConnectGetCapabilities", sig => "conn : string" },
55 { name => "virDomainFree", sig => "dom : free" },
56 { name => "virDomainDestroy", sig => "dom : free" },
57 { name => "virDomainLookupByName", sig => "conn, string : dom" },
58 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
59 { name => "virDomainGetName", sig => "dom : static string" },
60 { name => "virDomainGetOSType", sig => "dom : string" },
61 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
62 { name => "virDomainGetUUID", sig => "dom : uuid" },
63 { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
64 { name => "virDomainSuspend", sig => "dom : unit" },
65 { name => "virDomainResume", sig => "dom : unit" },
66 { name => "virDomainShutdown", sig => "dom : unit" },
67 { name => "virDomainReboot", sig => "dom, 0 : unit" },
68 { name => "virDomainUndefine", sig => "dom : unit" },
69 { name => "virDomainCreate", sig => "dom : unit" },
70 { name => "virDomainGetAutostart", sig => "dom : bool" },
71 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
73 { name => "virNetworkFree", sig => "net : free" },
74 { name => "virNetworkDestroy", sig => "net : free" },
75 { name => "virNetworkLookupByName", sig => "conn, string : net" },
76 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
77 { name => "virNetworkGetName", sig => "net : static string" },
78 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
79 { name => "virNetworkGetBridgeName", sig => "net : string" },
80 { name => "virNetworkGetUUID", sig => "net : uuid" },
81 { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
82 { name => "virNetworkUndefine", sig => "net : unit" },
83 { name => "virNetworkCreate", sig => "net : unit" },
84 { name => "virNetworkGetAutostart", sig => "net : bool" },
85 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
87 { name => "virStoragePoolFree",
88 sig => "pool : free", weak => 1 },
89 { name => "virStoragePoolDestroy",
90 sig => "pool : free", weak => 1 },
91 { name => "virStoragePoolLookupByName",
92 sig => "conn, string : pool", weak => 1 },
93 { name => "virStoragePoolLookupByUUIDString",
94 sig => "conn, string : pool", weak => 1 },
95 { name => "virStoragePoolGetName",
96 sig => "pool : static string", weak => 1 },
97 { name => "virStoragePoolGetXMLDesc",
98 sig => "pool, 0 : string", weak => 1 },
99 { name => "virStoragePoolGetUUID",
100 sig => "pool : uuid", weak => 1 },
101 { name => "virStoragePoolGetUUIDString",
102 sig => "pool : uuid string", weak => 1 },
103 { name => "virStoragePoolUndefine",
104 sig => "pool : unit", weak => 1 },
105 { name => "virStoragePoolCreate",
106 sig => "pool : unit", weak => 1 },
107 { name => "virStoragePoolShutdown",
108 sig => "pool : unit", weak => 1 },
109 { name => "virStoragePoolRefresh",
110 sig => "pool, 0U : unit", weak => 1 },
111 { name => "virStoragePoolGetAutostart",
112 sig => "pool : bool", weak => 1 },
113 { name => "virStoragePoolSetAutostart",
114 sig => "pool, bool : unit", weak => 1 },
116 { name => "virStorageVolFree", sig => "vol : free" },
117 { name => "virStorageVolDestroy", sig => "vol : free" },
118 # { name => "virStorageVolLookupByName", XXX see libvir-list posting
119 # sig => "pool, string : vol", weak => 1 },
120 { name => "virStorageVolLookupByKey",
121 sig => "conn, string : vol", weak => 1 },
122 { name => "virStorageVolLookupByPath",
123 sig => "conn, string : vol", weak => 1 },
124 { name => "virStorageVolGetXMLDesc",
125 sig => "vol, 0 : string", weak => 1 },
126 { name => "virStorageVolGetPath",
127 sig => "vol : string", weak => 1 },
128 { name => "virStorageVolGetKey",
129 sig => "vol : static string", weak => 1 },
130 { name => "virStorageVolGetName",
131 sig => "vol : static string", weak => 1 },
135 # Functions we haven't implemented anywhere yet.
136 # We create stubs for these, but they need to either be moved ^^ so they
137 # are auto-generated or implementations written in libvirt_c_oneoffs.c.
139 my @unimplemented = (
140 "ocaml_libvirt_domain_create_job",
141 "ocaml_libvirt_domain_core_dump_job",
142 "ocaml_libvirt_domain_restore_job",
143 "ocaml_libvirt_domain_save_job",
144 "ocaml_libvirt_connect_create_linux_job",
145 "ocaml_libvirt_network_create_job",
146 "ocaml_libvirt_network_create_xml_job",
147 "ocaml_libvirt_storage_pool_get_info",
148 "ocaml_libvirt_storage_pool_define_xml",
149 "ocaml_libvirt_storage_pool_create_xml",
150 "ocaml_libvirt_storage_pool_lookup_by_uuid",
151 "ocaml_libvirt_storage_vol_lookup_by_name", # XXX
152 "ocaml_libvirt_storage_vol_create_xml",
153 "ocaml_libvirt_storage_vol_get_info",
154 "ocaml_libvirt_pool_of_volume",
155 "ocaml_libvirt_job_cancel",
156 "ocaml_libvirt_job_get_network",
157 "ocaml_libvirt_job_get_domain",
158 "ocaml_libvirt_job_get_info",
161 #----------------------------------------------------------------------
163 # Open the output file.
165 my $filename = "libvirt_c.c";
166 open F, ">$filename" or die "$filename: $!";
168 # Write the prologue.
171 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
173 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
175 * Any changes you make to this file may be overwritten.
178 /* OCaml bindings for libvirt.
179 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
180 * http://libvirt.org/
182 * This library is free software; you can redistribute it and/or
183 * modify it under the terms of the GNU Lesser General Public
184 * License as published by the Free Software Foundation; either
185 * version 2 of the License, or (at your option) any later version.
187 * This library is distributed in the hope that it will be useful,
188 * but WITHOUT ANY WARRANTY; without even the implied warranty of
189 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
190 * Lesser General Public License for more details.
192 * You should have received a copy of the GNU Lesser General Public
193 * License along with this library; if not, write to the Free Software
194 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
203 #include <libvirt/libvirt.h>
204 #include <libvirt/virterror.h>
206 #include <caml/config.h>
207 #include <caml/alloc.h>
208 #include <caml/callback.h>
209 #include <caml/custom.h>
210 #include <caml/fail.h>
211 #include <caml/memory.h>
212 #include <caml/misc.h>
213 #include <caml/mlvalues.h>
214 #include <caml/signals.h>
216 #include "libvirt_c_prologue.c"
218 #include "libvirt_c_oneoffs.c"
222 #----------------------------------------------------------------------
224 sub camel_case_to_underscores
228 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
229 my @subs = split (/,/, $name);
230 @subs = map { lc($_) } @subs;
234 # Helper functions dealing with signatures.
236 sub short_name_to_c_type
240 if ($_ eq "conn") { "virConnectPtr" }
241 elsif ($_ eq "dom") { "virDomainPtr" }
242 elsif ($_ eq "net") { "virNetworkPtr" }
243 elsif ($_ eq "pool") { "virStoragePoolPtr" }
244 elsif ($_ eq "vol") { "virStorageVolPtr" }
246 die "unknown short name $_"
255 if ($sig =~ /^(\w+) : string$/) {
256 my $c_type = short_name_to_c_type ($1);
257 "char *$c_name ($c_type $1)"
258 } elsif ($sig =~ /^(\w+) : static string$/) {
259 my $c_type = short_name_to_c_type ($1);
260 "const char *$c_name ($c_type $1)"
261 } elsif ($sig =~ /^(\w+) : int$/) {
262 my $c_type = short_name_to_c_type ($1);
263 "int $c_name ($c_type $1)"
264 } elsif ($sig =~ /^(\w+) : uuid$/) {
265 my $c_type = short_name_to_c_type ($1);
266 "int $c_name ($c_type $1, unsigned char *)"
267 } elsif ($sig =~ /^(\w+) : uuid string$/) {
268 my $c_type = short_name_to_c_type ($1);
269 "int $c_name ($c_type $1, char *)"
270 } elsif ($sig =~ /^(\w+) : bool$/) {
271 my $c_type = short_name_to_c_type ($1);
272 "int $c_name ($c_type $1, int *r)"
273 } elsif ($sig =~ /^(\w+), bool : unit$/) {
274 my $c_type = short_name_to_c_type ($1);
275 "int $c_name ($c_type $1, int b)"
276 } elsif ($sig eq "conn, int : int array") {
277 "int $c_name (virConnectPtr conn, int *ids, int maxids)"
278 } elsif ($sig eq "conn, int : string array") {
279 "int $c_name (virConnectPtr conn, char **const names, int maxnames)"
280 } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
281 my $c_type = short_name_to_c_type ($1);
282 my $unsigned = $2 eq "U" ? "unsigned " : "";
283 "char *$c_name ($c_type $1, $unsigned int flags)"
284 } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
285 my $c_type = short_name_to_c_type ($1);
286 my $unsigned = $2 eq "U" ? "unsigned " : "";
287 "int $c_name ($c_type $1, $unsigned int flags)"
288 } elsif ($sig =~ /^(\w+) : unit$/) {
289 my $c_type = short_name_to_c_type ($1);
290 "int $c_name ($c_type $1)"
291 } elsif ($sig =~ /^(\w+) : free$/) {
292 my $c_type = short_name_to_c_type ($1);
293 "int $c_name ($c_type $1)"
294 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
295 my $c_type = short_name_to_c_type ($1);
296 my $c_ret_type = short_name_to_c_type ($2);
297 "$c_ret_type $c_name ($c_type $1, const char *str)"
299 die "unknown signature $sig"
307 if ($sig =~ /^(\w+) : string$/) {
309 } elsif ($sig =~ /^(\w+) : static string$/) {
311 } elsif ($sig =~ /^(\w+) : int$/) {
313 } elsif ($sig =~ /^(\w+) : uuid$/) {
315 } elsif ($sig =~ /^(\w+) : uuid string$/) {
317 } elsif ($sig =~ /^(\w+) : bool$/) {
319 } elsif ($sig =~ /^(\w+), bool : unit$/) {
321 } elsif ($sig eq "conn, int : int array") {
323 } elsif ($sig eq "conn, int : string array") {
325 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
327 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
329 } elsif ($sig =~ /^(\w+) : unit$/) {
331 } elsif ($sig =~ /^(\w+) : free$/) {
333 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
336 die "unknown signature $sig"
345 "virConnectPtr conn = Connect_val (connv);"
346 } elsif ($_ eq "dom") {
347 "virDomainPtr dom = Domain_val (domv);\n".
348 " virConnectPtr conn = Connect_domv (domv);"
349 } elsif ($_ eq "net") {
350 "virNetworkPtr net = Network_val (netv);\n".
351 " virConnectPtr conn = Connect_netv (netv);"
352 } elsif ($_ eq "pool") {
353 "virStoragePoolPtr pool = Pool_val (poolv);\n".
354 " virConnectPtr conn = Connect_polv (poolv);"
355 } elsif ($_ eq "vol") {
356 "virStorageVolPtr vol = Volume_val (volv);\n".
357 " virConnectPtr conn = Connect_volv (volv);"
359 die "unknown short name $_"
367 if ($_ eq "dom") { "rv = Val_domain (r, connv);" }
368 elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
369 elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
370 elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
372 die "unknown short name $_"
380 if ($_ eq "conn") { "Connect_val (connv) = NULL;" }
381 elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" }
382 elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
383 elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
384 elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
386 die "unknown short name $_"
395 if ($sig =~ /^(\w+) : string$/) {
398 " . gen_unpack_args ($1) . "
401 NONBLOCKING (r = $c_name ($1));
402 CHECK_ERROR (!r, conn, \"$c_name\");
404 rv = caml_copy_string (r);
408 } elsif ($sig =~ /^(\w+) : static string$/) {
411 " . gen_unpack_args ($1) . "
414 NONBLOCKING (r = $c_name ($1));
415 CHECK_ERROR (!r, conn, \"$c_name\");
417 rv = caml_copy_string (r);
420 } elsif ($sig =~ /^(\w+) : int$/) {
422 " . gen_unpack_args ($1) . "
425 NONBLOCKING (r = $c_name ($1));
426 CHECK_ERROR (r == -1, conn, \"$c_name\");
428 CAMLreturn (Val_int (r));
430 } elsif ($sig =~ /^(\w+) : uuid$/) {
433 " . gen_unpack_args ($1) . "
434 unsigned char uuid[VIR_UUID_BUFLEN];
437 NONBLOCKING (r = $c_name ($1, uuid));
438 CHECK_ERROR (r == -1, conn, \"$c_name\");
440 rv = caml_copy_string ((char *) uuid);
443 } elsif ($sig =~ /^(\w+) : uuid string$/) {
446 " . gen_unpack_args ($1) . "
447 char uuid[VIR_UUID_STRING_BUFLEN];
450 NONBLOCKING (r = $c_name ($1, uuid));
451 CHECK_ERROR (r == -1, conn, \"$c_name\");
453 rv = caml_copy_string (uuid);
456 } elsif ($sig =~ /^(\w+) : bool$/) {
458 " . gen_unpack_args ($1) . "
461 NONBLOCKING (r = $c_name ($1, &b));
462 CHECK_ERROR (r == -1, conn, \"$c_name\");
464 CAMLreturn (b ? Val_true : Val_false);
466 } elsif ($sig =~ /^(\w+), bool : unit$/) {
468 " . gen_unpack_args ($1) . "
471 b = bv == Val_true ? 1 : 0;
473 NONBLOCKING (r = $c_name ($1, b));
474 CHECK_ERROR (r == -1, conn, \"$c_name\");
476 CAMLreturn (Val_unit);
478 } elsif ($sig eq "conn, int : int array") {
481 virConnectPtr conn = Connect_val (connv);
482 int i = Int_val (iv);
485 NONBLOCKING (r = $c_name (conn, ids, i));
486 CHECK_ERROR (r == -1, conn, \"$c_name\");
488 rv = caml_alloc (r, 0);
489 for (i = 0; i < r; ++i)
490 Store_field (rv, i, Val_int (ids[i]));
494 } elsif ($sig eq "conn, int : string array") {
496 CAMLlocal2 (rv, strv);
497 virConnectPtr conn = Connect_val (connv);
498 int i = Int_val (iv);
502 NONBLOCKING (r = $c_name (conn, names, i));
503 CHECK_ERROR (r == -1, conn, \"$c_name\");
505 rv = caml_alloc (r, 0);
506 for (i = 0; i < r; ++i) {
507 strv = caml_copy_string (names[i]);
508 Store_field (rv, i, strv);
514 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
517 " . gen_unpack_args ($1) . "
520 NONBLOCKING (r = $c_name ($1, 0));
521 CHECK_ERROR (!r, conn, \"$c_name\");
523 rv = caml_copy_string (r);
527 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
529 " . gen_unpack_args ($1) . "
532 NONBLOCKING (r = $c_name ($1, 0));
533 CHECK_ERROR (r == -1, conn, \"$c_name\");
535 CAMLreturn (Val_unit);
537 } elsif ($sig =~ /^(\w+) : unit$/) {
539 " . gen_unpack_args ($1) . "
542 NONBLOCKING (r = $c_name ($1));
543 CHECK_ERROR (r == -1, conn, \"$c_name\");
545 CAMLreturn (Val_unit);
547 } elsif ($sig =~ /^(\w+) : free$/) {
549 " . gen_unpack_args ($1) . "
552 NONBLOCKING (r = $c_name ($1));
553 CHECK_ERROR (r == -1, conn, \"$c_name\");
555 /* So that we don't double-free in the finalizer: */
556 " . gen_free_arg ($1) . "
558 CAMLreturn (Val_unit);
560 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
561 my $c_ret_type = short_name_to_c_type ($2);
564 " . gen_unpack_args ($1) . "
565 char *str = String_val (strv);
568 NONBLOCKING (r = $c_name ($1, str));
569 CHECK_ERROR (!r, conn, \"$c_name\");
571 " . gen_pack_result ($2) . "
576 die "unknown signature $sig"
580 # Generate each function.
582 foreach my $function (@functions) {
583 my $c_name = $function->{name};
584 my $is_weak = $function->{weak};
585 my $sig = $function->{sig};
587 my $is_pool_func = $c_name =~ /^virStoragePool/;
588 my $is_vol_func = $c_name =~ /^virStorageVol/;
590 # Generate an equivalent C-external name for the function, unless
591 # one is defined already.
593 if (exists ($function->{c_external_name})) {
594 $c_external_name = $function->{c_external_name};
595 } elsif ($c_name =~ /^vir/) {
596 $c_external_name = substr $c_name, 3;
597 $c_external_name = camel_case_to_underscores ($c_external_name);
598 $c_external_name = "ocaml_libvirt_" . $c_external_name;
600 die "cannot convert c_name $c_name to c_external_name"
603 # Generate a full function prototype if the function is weak.
604 my $have_name = "HAVE_" . uc ($c_name);
606 my $c_sig = gen_c_signature ($sig, $c_name);
608 #ifdef HAVE_WEAK_SYMBOLS
610 extern $c_sig __attribute__((weak));
617 my @arg_names = gen_arg_names ($sig);
618 my $nr_arg_names = scalar @arg_names;
619 my $arg_names = join ", ", @arg_names;
620 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
622 # Generate the start of the function, arguments.
625 $c_external_name ($arg_names_as_values)
627 CAMLparam$nr_arg_names ($arg_names);
630 # If weak, check the function exists at compile time or runtime.
634 /* Symbol $c_name not found at compile time. */
635 not_supported ("$c_name");
636 /* Suppresses a compiler warning. */
639 /* Check that the symbol $c_name
640 * is in runtime version of libvirt.
642 WEAK_SYMBOL_CHECK ($c_name);
646 # Generate the internals of the function.
647 print F (gen_c_code ($sig, $c_name));
649 # Finish off weak #ifdef.
656 # Finish off the function.
663 #----------------------------------------------------------------------
665 # Unimplemented functions.
667 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
670 /* The following functions are unimplemented and always fail.
671 * See generator.pl '@unimplemented'
676 foreach my $c_external_name (@unimplemented) {
681 failwith ("$c_external_name is unimplemented");
687 #----------------------------------------------------------------------
689 # Write the epilogue.
692 #include "libvirt_c_epilogue.c"
698 print "$0: written $filename\n"