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 => "virConnectGetHostname", sig => "conn : string", weak => 1 },
33 { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
34 { name => "virConnectGetType", sig => "conn : static string" },
35 { name => "virConnectNumOfDomains", sig => "conn : int" },
36 { name => "virConnectListDomains", sig => "conn, int : int array" },
37 { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
38 { name => "virConnectListDefinedDomains",
39 sig => "conn, int : string array" },
40 { name => "virConnectNumOfNetworks", sig => "conn : int" },
41 { name => "virConnectListNetworks", sig => "conn, int : string array" },
42 { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
43 { name => "virConnectListDefinedNetworks",
44 sig => "conn, int : string array" },
45 { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
46 { name => "virConnectListStoragePools",
47 sig => "conn, int : string array", weak => 1 },
48 { name => "virConnectNumOfDefinedStoragePools",
49 sig => "conn : int", weak => 1 },
50 { name => "virConnectListDefinedStoragePools",
51 sig => "conn, int : string array", weak => 1 },
52 { name => "virConnectGetCapabilities", sig => "conn : string" },
54 { name => "virDomainGetName", sig => "dom : static string" },
55 { name => "virDomainGetOSType", sig => "dom : string" },
56 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
57 { name => "virDomainSuspend", sig => "dom : unit" },
58 { name => "virDomainResume", sig => "dom : unit" },
59 { name => "virDomainShutdown", sig => "dom : unit" },
60 { name => "virDomainReboot", sig => "dom, 0 : unit" },
61 { name => "virDomainUndefine", sig => "dom : unit" },
62 { name => "virDomainCreate", sig => "dom : unit" },
64 { name => "virNetworkGetName", sig => "net : static string" },
65 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
66 { name => "virNetworkGetBridgeName", sig => "net : string" },
67 { name => "virNetworkUndefine", sig => "net : unit" },
68 { name => "virNetworkCreate", sig => "net : unit" },
70 { name => "virStoragePoolGetName",
71 sig => "pool : static string", weak => 1 },
72 { name => "virStoragePoolGetXMLDesc",
73 sig => "pool, 0 : string", weak => 1 },
74 { name => "virStoragePoolUndefine",
75 sig => "pool : string", weak => 1 },
76 { name => "virStoragePoolCreate",
77 sig => "pool : string", weak => 1 },
78 { name => "virStoragePoolShutdown",
79 sig => "pool : string", weak => 1 },
80 { name => "virStoragePoolRefresh",
81 sig => "pool, 0 : string", weak => 1 },
83 { name => "virStorageVolGetXMLDesc",
84 sig => "pool, 0 : string", weak => 1 },
85 { name => "virStorageVolGetPath",
86 sig => "pool : string", weak => 1 },
87 { name => "virStorageVolGetKey",
88 sig => "pool : static string", weak => 1 },
89 { name => "virStorageVolGetName",
90 sig => "pool : static string", weak => 1 },
94 # Functions we haven't implemented anywhere yet.
95 # We create stubs for these, but they need to either be moved ^^ so they
96 # are auto-generated or implementations written in libvirt_c_oneoffs.c.
99 "ocaml_libvirt_domain_create_job",
100 "ocaml_libvirt_domain_core_dump_job",
101 "ocaml_libvirt_domain_restore_job",
102 "ocaml_libvirt_domain_save_job",
103 "ocaml_libvirt_connect_create_linux_job",
104 "ocaml_libvirt_network_create_job",
105 "ocaml_libvirt_network_create_xml_job",
106 "ocaml_libvirt_storage_pool_set_autostart",
107 "ocaml_libvirt_storage_pool_get_autostart",
108 "ocaml_libvirt_storage_pool_get_info",
109 "ocaml_libvirt_storage_pool_get_uuid_string",
110 "ocaml_libvirt_storage_pool_get_uuid",
111 "ocaml_libvirt_storage_pool_free",
112 "ocaml_libvirt_storage_pool_destroy",
113 "ocaml_libvirt_storage_pool_define_xml",
114 "ocaml_libvirt_storage_pool_create_xml",
115 "ocaml_libvirt_storage_pool_lookup_by_uuid_string",
116 "ocaml_libvirt_storage_pool_lookup_by_uuid",
117 "ocaml_libvirt_storage_pool_lookup_by_name",
118 "ocaml_libvirt_storage_vol_free",
119 "ocaml_libvirt_storage_vol_destroy",
120 "ocaml_libvirt_storage_vol_create_xml",
121 "ocaml_libvirt_storage_vol_get_info",
122 "ocaml_libvirt_pool_of_volume",
123 "ocaml_libvirt_storage_vol_lookup_by_path",
124 "ocaml_libvirt_storage_vol_lookup_by_key",
125 "ocaml_libvirt_storage_vol_lookup_by_name",
126 "ocaml_libvirt_job_cancel",
127 "ocaml_libvirt_job_get_network",
128 "ocaml_libvirt_job_get_domain",
129 "ocaml_libvirt_job_get_info",
132 #----------------------------------------------------------------------
134 # Open the output file.
136 my $filename = "libvirt_c.c";
137 open F, ">$filename" or die "$filename: $!";
139 # Write the prologue.
142 /* WARNING: THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
143 * Any changes you make to this file may be overwritten.
146 /* OCaml bindings for libvirt.
147 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
148 * http://libvirt.org/
150 * This library is free software; you can redistribute it and/or
151 * modify it under the terms of the GNU Lesser General Public
152 * License as published by the Free Software Foundation; either
153 * version 2 of the License, or (at your option) any later version.
155 * This library is distributed in the hope that it will be useful,
156 * but WITHOUT ANY WARRANTY; without even the implied warranty of
157 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
158 * Lesser General Public License for more details.
160 * You should have received a copy of the GNU Lesser General Public
161 * License along with this library; if not, write to the Free Software
162 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
171 #include <libvirt/libvirt.h>
172 #include <libvirt/virterror.h>
174 #include <caml/config.h>
175 #include <caml/alloc.h>
176 #include <caml/callback.h>
177 #include <caml/custom.h>
178 #include <caml/fail.h>
179 #include <caml/memory.h>
180 #include <caml/misc.h>
181 #include <caml/mlvalues.h>
182 #include <caml/signals.h>
184 #include "libvirt_c_prologue.c"
186 #include "libvirt_c_oneoffs.c"
190 #----------------------------------------------------------------------
192 sub camel_case_to_underscores
196 $name =~ s/([A-Z][a-z]+|XML|URI|OS)/$1,/g;
197 my @subs = split (/,/, $name);
198 @subs = map { lc($_) } @subs;
202 # Helper functions dealing with signatures.
204 sub short_name_to_c_type
208 if ($_ eq "conn") { "virConnectPtr" }
209 elsif ($_ eq "dom") { "virDomainPtr" }
210 elsif ($_ eq "net") { "virNetworkPtr" }
211 elsif ($_ eq "pool") { "virStoragePoolPtr" }
212 elsif ($_ eq "vol") { "virStorageVolPtr" }
214 die "unknown short name $_"
223 if ($sig =~ /^(\w+) : string$/) {
224 my $c_type = short_name_to_c_type ($1);
225 "char *$c_name ($c_type $1)"
226 } elsif ($sig =~ /^(\w+) : static string$/) {
227 my $c_type = short_name_to_c_type ($1);
228 "const char *$c_name ($c_type $1)"
229 } elsif ($sig =~ /^(\w+) : int$/) {
230 my $c_type = short_name_to_c_type ($1);
231 "int $c_name ($c_type $1)"
232 } elsif ($sig eq "conn, int : int array") {
233 "int $c_name (virConnectPtr conn, int *ids, int maxids)"
234 } elsif ($sig eq "conn, int : string array") {
235 "int $c_name (virConnectPtr conn, char **const names, int maxnames)"
236 } elsif ($sig =~ /^(\w+), 0 : string$/) {
237 my $c_type = short_name_to_c_type ($1);
238 "char *$c_name ($c_type $1, int flags)"
239 } elsif ($sig =~ /^(\w+), 0 : unit$/) {
240 my $c_type = short_name_to_c_type ($1);
241 "int $c_name ($c_type $1, int flags)"
242 } elsif ($sig =~ /^(\w+) : unit$/) {
243 my $c_type = short_name_to_c_type ($1);
244 "int $c_name ($c_type $1 dom)"
246 die "unknown signature $sig"
254 if ($sig =~ /^(\w+) : string$/) {
256 } elsif ($sig =~ /^(\w+) : static string$/) {
258 } elsif ($sig =~ /^(\w+) : int$/) {
260 } elsif ($sig eq "conn, int : int array") {
262 } elsif ($sig eq "conn, int : string array") {
264 } elsif ($sig =~ /^(\w+), 0 : string$/) {
266 } elsif ($sig =~ /^(\w+), 0 : unit$/) {
268 } elsif ($sig =~ /^(\w+) : unit$/) {
271 die "unknown signature $sig"
280 "virConnectPtr conn = Connect_val (connv);"
281 } elsif ($_ eq "dom") {
282 "virDomainPtr dom = Domain_val (domv);\n".
283 " virConnectPtr conn = Connect_domv (domv);"
284 } elsif ($_ eq "net") {
285 "virNetworkPtr net = Network_val (netv);\n".
286 " virConnectPtr conn = Connect_netv (netv);"
287 } elsif ($_ eq "pool") {
288 "virStoragePoolPtr pool = Pool_val (poolv);\n".
289 " virConnectPtr conn = Connect_polv (poolv);"
290 } elsif ($_ eq "vol") {
291 "virStorageVolPtr vol = Volume_val (volv);\n".
292 " virConnectPtr conn = Connect_volv (volv);"
294 die "unknown short name $_"
303 if ($sig =~ /^(\w+) : string$/) {
306 " . gen_unpack_args ($1) . "
309 NONBLOCKING (r = $c_name ($1));
310 CHECK_ERROR (!r, conn, \"$c_name\");
312 rv = caml_copy_string (r);
316 } elsif ($sig =~ /^(\w+) : static string$/) {
319 " . gen_unpack_args ($1) . "
322 NONBLOCKING (r = $c_name ($1));
323 CHECK_ERROR (!r, conn, \"$c_name\");
325 rv = caml_copy_string (r);
328 } elsif ($sig =~ /^(\w+) : int$/) {
330 " . gen_unpack_args ($1) . "
333 NONBLOCKING (r = $c_name ($1));
334 CHECK_ERROR (r == -1, conn, \"$c_name\");
336 CAMLreturn (Val_int (r));
338 } elsif ($sig eq "conn, int : int array") {
341 virConnectPtr conn = Connect_val (connv);
342 int i = Int_val (iv);
345 NONBLOCKING (r = $c_name (conn, ids, i));
346 CHECK_ERROR (r == -1, conn, \"$c_name\");
348 rv = caml_alloc (r, 0);
349 for (i = 0; i < r; ++i)
350 Store_field (rv, i, Val_int (ids[i]));
354 } elsif ($sig eq "conn, int : string array") {
356 CAMLlocal2 (rv, strv);
357 virConnectPtr conn = Connect_val (connv);
358 int i = Int_val (iv);
362 NONBLOCKING (r = $c_name (conn, names, i));
363 CHECK_ERROR (r == -1, conn, \"$c_name\");
365 rv = caml_alloc (r, 0);
366 for (i = 0; i < r; ++i) {
367 strv = caml_copy_string (names[i]);
368 Store_field (rv, i, strv);
374 } elsif ($sig =~ /^(\w+), 0 : string$/) {
377 " . gen_unpack_args ($1) . "
380 NONBLOCKING (r = $c_name ($1, 0));
381 CHECK_ERROR (!r, conn, \"$c_name\");
383 rv = caml_copy_string (r);
387 } elsif ($sig =~ /^(\w+) : unit$/) {
389 " . gen_unpack_args ($1) . "
392 NONBLOCKING (r = $c_name ($1));
393 CHECK_ERROR (r == -1, conn, \"$c_name\");
395 CAMLreturn (Val_unit);
397 } elsif ($sig =~ /^(\w+), 0 : unit$/) {
399 " . gen_unpack_args ($1) . "
402 NONBLOCKING (r = $c_name ($1, 0));
403 CHECK_ERROR (r == -1, conn, \"$c_name\");
405 CAMLreturn (Val_unit);
408 die "unknown signature $sig"
412 # Generate each function.
414 foreach my $function (@functions) {
415 my $c_name = $function->{name};
416 my $is_weak = $function->{weak};
417 my $sig = $function->{sig};
419 my $is_pool_func = $c_name =~ /^virStoragePool/;
420 my $is_vol_func = $c_name =~ /^virStorageVol/;
422 # Generate an equivalent C-external name for the function, unless
423 # one is defined already.
425 if (exists ($function->{c_external_name})) {
426 $c_external_name = $function->{c_external_name};
427 } elsif ($c_name =~ /^vir/) {
428 $c_external_name = substr $c_name, 3;
429 $c_external_name = camel_case_to_underscores ($c_external_name);
430 $c_external_name = "ocaml_libvirt_" . $c_external_name;
432 die "cannot convert c_name $c_name to c_external_name"
435 # Generate a full function prototype if the function is weak.
436 my $have_name = "HAVE_" . uc ($c_name);
438 my $c_sig = gen_c_signature ($sig, $c_name);
440 #ifdef HAVE_WEAK_SYMBOLS
442 extern $c_sig __attribute__((weak));
449 my @arg_names = gen_arg_names ($sig);
450 my $nr_arg_names = scalar @arg_names;
451 my $arg_names = join ", ", @arg_names;
452 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
454 # Generate the start of the function, arguments.
457 $c_external_name ($arg_names_as_values)
459 CAMLparam$nr_arg_names ($arg_names);
462 # If weak, check the function exists at compile time or runtime.
466 /* Symbol $c_name not found at compile time. */
467 not_supported ("$c_name");
468 /* Suppresses a compiler warning. */
471 /* Check that the symbol $c_name
472 * is in runtime version of libvirt.
474 WEAK_SYMBOL_CHECK ($c_name);
478 # Generate the internals of the function.
479 print F (gen_c_code ($sig, $c_name));
481 # Finish off weak #ifdef.
488 # Finish off the function.
495 #----------------------------------------------------------------------
497 # Unimplemented functions.
499 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
501 foreach my $c_external_name (@unimplemented) {
506 failwith ("$c_external_name is unimplemented");
512 #----------------------------------------------------------------------
514 # Write the epilogue.
517 #include "libvirt_c_epilogue.c"
523 print "$0: written $filename\n"