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 => "virDomainLookupByName", sig => "conn, string : dom" },
55 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
56 { name => "virDomainGetName", sig => "dom : static string" },
57 { name => "virDomainGetOSType", sig => "dom : string" },
58 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
59 { name => "virDomainSuspend", sig => "dom : unit" },
60 { name => "virDomainResume", sig => "dom : unit" },
61 { name => "virDomainShutdown", sig => "dom : unit" },
62 { name => "virDomainReboot", sig => "dom, 0 : unit" },
63 { name => "virDomainUndefine", sig => "dom : unit" },
64 { name => "virDomainCreate", sig => "dom : unit" },
65 { name => "virDomainGetAutostart", sig => "dom : bool" },
66 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
68 { name => "virNetworkLookupByName", sig => "conn, string : net" },
69 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
70 { name => "virNetworkGetName", sig => "net : static string" },
71 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
72 { name => "virNetworkGetBridgeName", sig => "net : string" },
73 { name => "virNetworkUndefine", sig => "net : unit" },
74 { name => "virNetworkCreate", sig => "net : unit" },
75 { name => "virNetworkGetAutostart", sig => "net : bool" },
76 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
78 { name => "virStoragePoolLookupByName",
79 sig => "conn, string : pool", weak => 1 },
80 { name => "virStoragePoolLookupByUUIDString",
81 sig => "conn, string : pool", weak => 1 },
82 { name => "virStoragePoolGetName",
83 sig => "pool : static string", weak => 1 },
84 { name => "virStoragePoolGetXMLDesc",
85 sig => "pool, 0 : string", weak => 1 },
86 { name => "virStoragePoolUndefine",
87 sig => "pool : unit", weak => 1 },
88 { name => "virStoragePoolCreate",
89 sig => "pool : unit", weak => 1 },
90 { name => "virStoragePoolShutdown",
91 sig => "pool : unit", weak => 1 },
92 { name => "virStoragePoolRefresh",
93 sig => "pool, 0U : unit", weak => 1 },
94 { name => "virStoragePoolGetAutostart",
95 sig => "pool : bool", weak => 1 },
96 { name => "virStoragePoolSetAutostart",
97 sig => "pool, bool : unit", weak => 1 },
99 # { name => "virStorageVolLookupByName", XXX see libvir-list posting
100 # sig => "pool, string : vol", weak => 1 },
101 { name => "virStorageVolLookupByKey",
102 sig => "conn, string : vol", weak => 1 },
103 { name => "virStorageVolLookupByPath",
104 sig => "conn, string : vol", weak => 1 },
105 { name => "virStorageVolGetXMLDesc",
106 sig => "vol, 0 : string", weak => 1 },
107 { name => "virStorageVolGetPath",
108 sig => "vol : string", weak => 1 },
109 { name => "virStorageVolGetKey",
110 sig => "vol : static string", weak => 1 },
111 { name => "virStorageVolGetName",
112 sig => "vol : static string", weak => 1 },
116 # Functions we haven't implemented anywhere yet.
117 # We create stubs for these, but they need to either be moved ^^ so they
118 # are auto-generated or implementations written in libvirt_c_oneoffs.c.
120 my @unimplemented = (
121 "ocaml_libvirt_domain_create_job",
122 "ocaml_libvirt_domain_core_dump_job",
123 "ocaml_libvirt_domain_restore_job",
124 "ocaml_libvirt_domain_save_job",
125 "ocaml_libvirt_connect_create_linux_job",
126 "ocaml_libvirt_network_create_job",
127 "ocaml_libvirt_network_create_xml_job",
128 "ocaml_libvirt_storage_pool_get_info",
129 "ocaml_libvirt_storage_pool_get_uuid_string", #?
130 "ocaml_libvirt_storage_pool_get_uuid", #?
131 "ocaml_libvirt_storage_pool_free", #?
132 "ocaml_libvirt_storage_pool_destroy", #?
133 "ocaml_libvirt_storage_pool_define_xml",
134 "ocaml_libvirt_storage_pool_create_xml",
135 "ocaml_libvirt_storage_pool_lookup_by_uuid",
136 "ocaml_libvirt_storage_vol_lookup_by_name", # XXX
137 "ocaml_libvirt_storage_vol_free", #?
138 "ocaml_libvirt_storage_vol_destroy", #?
139 "ocaml_libvirt_storage_vol_create_xml",
140 "ocaml_libvirt_storage_vol_get_info",
141 "ocaml_libvirt_pool_of_volume",
142 "ocaml_libvirt_job_cancel",
143 "ocaml_libvirt_job_get_network",
144 "ocaml_libvirt_job_get_domain",
145 "ocaml_libvirt_job_get_info",
148 #----------------------------------------------------------------------
150 # Open the output file.
152 my $filename = "libvirt_c.c";
153 open F, ">$filename" or die "$filename: $!";
155 # Write the prologue.
158 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
160 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
162 * Any changes you make to this file may be overwritten.
165 /* OCaml bindings for libvirt.
166 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
167 * http://libvirt.org/
169 * This library is free software; you can redistribute it and/or
170 * modify it under the terms of the GNU Lesser General Public
171 * License as published by the Free Software Foundation; either
172 * version 2 of the License, or (at your option) any later version.
174 * This library is distributed in the hope that it will be useful,
175 * but WITHOUT ANY WARRANTY; without even the implied warranty of
176 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
177 * Lesser General Public License for more details.
179 * You should have received a copy of the GNU Lesser General Public
180 * License along with this library; if not, write to the Free Software
181 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
190 #include <libvirt/libvirt.h>
191 #include <libvirt/virterror.h>
193 #include <caml/config.h>
194 #include <caml/alloc.h>
195 #include <caml/callback.h>
196 #include <caml/custom.h>
197 #include <caml/fail.h>
198 #include <caml/memory.h>
199 #include <caml/misc.h>
200 #include <caml/mlvalues.h>
201 #include <caml/signals.h>
203 #include "libvirt_c_prologue.c"
205 #include "libvirt_c_oneoffs.c"
209 #----------------------------------------------------------------------
211 sub camel_case_to_underscores
215 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
216 my @subs = split (/,/, $name);
217 @subs = map { lc($_) } @subs;
221 # Helper functions dealing with signatures.
223 sub short_name_to_c_type
227 if ($_ eq "conn") { "virConnectPtr" }
228 elsif ($_ eq "dom") { "virDomainPtr" }
229 elsif ($_ eq "net") { "virNetworkPtr" }
230 elsif ($_ eq "pool") { "virStoragePoolPtr" }
231 elsif ($_ eq "vol") { "virStorageVolPtr" }
233 die "unknown short name $_"
242 if ($sig =~ /^(\w+) : string$/) {
243 my $c_type = short_name_to_c_type ($1);
244 "char *$c_name ($c_type $1)"
245 } elsif ($sig =~ /^(\w+) : static string$/) {
246 my $c_type = short_name_to_c_type ($1);
247 "const char *$c_name ($c_type $1)"
248 } elsif ($sig =~ /^(\w+) : int$/) {
249 my $c_type = short_name_to_c_type ($1);
250 "int $c_name ($c_type $1)"
251 } elsif ($sig =~ /^(\w+) : bool$/) {
252 my $c_type = short_name_to_c_type ($1);
253 "int $c_name ($c_type $1, int *r)"
254 } elsif ($sig =~ /^(\w+), bool : unit$/) {
255 my $c_type = short_name_to_c_type ($1);
256 "int $c_name ($c_type $1, int b)"
257 } elsif ($sig eq "conn, int : int array") {
258 "int $c_name (virConnectPtr conn, int *ids, int maxids)"
259 } elsif ($sig eq "conn, int : string array") {
260 "int $c_name (virConnectPtr conn, char **const names, int maxnames)"
261 } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
262 my $c_type = short_name_to_c_type ($1);
263 my $unsigned = $2 eq "U" ? "unsigned " : "";
264 "char *$c_name ($c_type $1, $unsigned int flags)"
265 } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
266 my $c_type = short_name_to_c_type ($1);
267 my $unsigned = $2 eq "U" ? "unsigned " : "";
268 "int $c_name ($c_type $1, $unsigned int flags)"
269 } elsif ($sig =~ /^(\w+) : unit$/) {
270 my $c_type = short_name_to_c_type ($1);
271 "int $c_name ($c_type $1)"
272 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
273 my $c_type = short_name_to_c_type ($1);
274 my $c_ret_type = short_name_to_c_type ($2);
275 "$c_ret_type $c_name ($c_type $1, const char *str)"
277 die "unknown signature $sig"
285 if ($sig =~ /^(\w+) : string$/) {
287 } elsif ($sig =~ /^(\w+) : static string$/) {
289 } elsif ($sig =~ /^(\w+) : int$/) {
291 } elsif ($sig =~ /^(\w+) : bool$/) {
293 } elsif ($sig =~ /^(\w+), bool : unit$/) {
295 } elsif ($sig eq "conn, int : int array") {
297 } elsif ($sig eq "conn, int : string array") {
299 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
301 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
303 } elsif ($sig =~ /^(\w+) : unit$/) {
305 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
308 die "unknown signature $sig"
317 "virConnectPtr conn = Connect_val (connv);"
318 } elsif ($_ eq "dom") {
319 "virDomainPtr dom = Domain_val (domv);\n".
320 " virConnectPtr conn = Connect_domv (domv);"
321 } elsif ($_ eq "net") {
322 "virNetworkPtr net = Network_val (netv);\n".
323 " virConnectPtr conn = Connect_netv (netv);"
324 } elsif ($_ eq "pool") {
325 "virStoragePoolPtr pool = Pool_val (poolv);\n".
326 " virConnectPtr conn = Connect_polv (poolv);"
327 } elsif ($_ eq "vol") {
328 "virStorageVolPtr vol = Volume_val (volv);\n".
329 " virConnectPtr conn = Connect_volv (volv);"
331 die "unknown short name $_"
340 "rv = Val_domain (r, connv);"
341 } elsif ($_ eq "net") {
342 "rv = Val_network (r, connv);"
343 } elsif ($_ eq "pool") {
344 "rv = Val_pool (r, connv);"
345 } elsif ($_ eq "vol") {
346 "rv = Val_volume (r, connv);"
355 if ($sig =~ /^(\w+) : string$/) {
358 " . gen_unpack_args ($1) . "
361 NONBLOCKING (r = $c_name ($1));
362 CHECK_ERROR (!r, conn, \"$c_name\");
364 rv = caml_copy_string (r);
368 } elsif ($sig =~ /^(\w+) : static string$/) {
371 " . gen_unpack_args ($1) . "
374 NONBLOCKING (r = $c_name ($1));
375 CHECK_ERROR (!r, conn, \"$c_name\");
377 rv = caml_copy_string (r);
380 } elsif ($sig =~ /^(\w+) : int$/) {
382 " . gen_unpack_args ($1) . "
385 NONBLOCKING (r = $c_name ($1));
386 CHECK_ERROR (r == -1, conn, \"$c_name\");
388 CAMLreturn (Val_int (r));
390 } elsif ($sig =~ /^(\w+) : bool$/) {
392 " . gen_unpack_args ($1) . "
395 NONBLOCKING (r = $c_name ($1, &b));
396 CHECK_ERROR (r == -1, conn, \"$c_name\");
398 CAMLreturn (b ? Val_true : Val_false);
400 } elsif ($sig =~ /^(\w+), bool : unit$/) {
402 " . gen_unpack_args ($1) . "
405 b = bv == Val_true ? 1 : 0;
407 NONBLOCKING (r = $c_name ($1, b));
408 CHECK_ERROR (r == -1, conn, \"$c_name\");
410 CAMLreturn (Val_unit);
412 } elsif ($sig eq "conn, int : int array") {
415 virConnectPtr conn = Connect_val (connv);
416 int i = Int_val (iv);
419 NONBLOCKING (r = $c_name (conn, ids, i));
420 CHECK_ERROR (r == -1, conn, \"$c_name\");
422 rv = caml_alloc (r, 0);
423 for (i = 0; i < r; ++i)
424 Store_field (rv, i, Val_int (ids[i]));
428 } elsif ($sig eq "conn, int : string array") {
430 CAMLlocal2 (rv, strv);
431 virConnectPtr conn = Connect_val (connv);
432 int i = Int_val (iv);
436 NONBLOCKING (r = $c_name (conn, names, i));
437 CHECK_ERROR (r == -1, conn, \"$c_name\");
439 rv = caml_alloc (r, 0);
440 for (i = 0; i < r; ++i) {
441 strv = caml_copy_string (names[i]);
442 Store_field (rv, i, strv);
448 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
451 " . gen_unpack_args ($1) . "
454 NONBLOCKING (r = $c_name ($1, 0));
455 CHECK_ERROR (!r, conn, \"$c_name\");
457 rv = caml_copy_string (r);
461 } elsif ($sig =~ /^(\w+) : unit$/) {
463 " . gen_unpack_args ($1) . "
466 NONBLOCKING (r = $c_name ($1));
467 CHECK_ERROR (r == -1, conn, \"$c_name\");
469 CAMLreturn (Val_unit);
471 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
473 " . gen_unpack_args ($1) . "
476 NONBLOCKING (r = $c_name ($1, 0));
477 CHECK_ERROR (r == -1, conn, \"$c_name\");
479 CAMLreturn (Val_unit);
481 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
482 my $c_ret_type = short_name_to_c_type ($2);
485 " . gen_unpack_args ($1) . "
486 char *str = String_val (strv);
489 NONBLOCKING (r = $c_name ($1, str));
490 CHECK_ERROR (!r, conn, \"$c_name\");
492 " . gen_pack_result ($2) . "
497 die "unknown signature $sig"
501 # Generate each function.
503 foreach my $function (@functions) {
504 my $c_name = $function->{name};
505 my $is_weak = $function->{weak};
506 my $sig = $function->{sig};
508 my $is_pool_func = $c_name =~ /^virStoragePool/;
509 my $is_vol_func = $c_name =~ /^virStorageVol/;
511 # Generate an equivalent C-external name for the function, unless
512 # one is defined already.
514 if (exists ($function->{c_external_name})) {
515 $c_external_name = $function->{c_external_name};
516 } elsif ($c_name =~ /^vir/) {
517 $c_external_name = substr $c_name, 3;
518 $c_external_name = camel_case_to_underscores ($c_external_name);
519 $c_external_name = "ocaml_libvirt_" . $c_external_name;
521 die "cannot convert c_name $c_name to c_external_name"
524 # Generate a full function prototype if the function is weak.
525 my $have_name = "HAVE_" . uc ($c_name);
527 my $c_sig = gen_c_signature ($sig, $c_name);
529 #ifdef HAVE_WEAK_SYMBOLS
531 extern $c_sig __attribute__((weak));
538 my @arg_names = gen_arg_names ($sig);
539 my $nr_arg_names = scalar @arg_names;
540 my $arg_names = join ", ", @arg_names;
541 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
543 # Generate the start of the function, arguments.
546 $c_external_name ($arg_names_as_values)
548 CAMLparam$nr_arg_names ($arg_names);
551 # If weak, check the function exists at compile time or runtime.
555 /* Symbol $c_name not found at compile time. */
556 not_supported ("$c_name");
557 /* Suppresses a compiler warning. */
560 /* Check that the symbol $c_name
561 * is in runtime version of libvirt.
563 WEAK_SYMBOL_CHECK ($c_name);
567 # Generate the internals of the function.
568 print F (gen_c_code ($sig, $c_name));
570 # Finish off weak #ifdef.
577 # Finish off the function.
584 #----------------------------------------------------------------------
586 # Unimplemented functions.
588 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
590 foreach my $c_external_name (@unimplemented) {
595 failwith ("$c_external_name is unimplemented");
601 #----------------------------------------------------------------------
603 # Write the epilogue.
606 #include "libvirt_c_epilogue.c"
612 print "$0: written $filename\n"