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).
25 # Please read libvirt/README.
29 #----------------------------------------------------------------------
31 # The functions in the libvirt API that we can generate.
33 # The 'sig' (signature) doesn't have a meaning or any internal structure.
34 # It is interpreted by the generation functions below to indicate what
35 # "class" the function falls into, and to generate the right class of
38 # Any function added since libvirt 0.2.1 must be marked weak.
41 { name => "virConnectClose", sig => "conn : free" },
42 { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
43 { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
44 { name => "virConnectGetType", sig => "conn : static string" },
45 { name => "virConnectNumOfDomains", sig => "conn : int" },
46 { name => "virConnectListDomains", sig => "conn, int : int array" },
47 { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
48 { name => "virConnectListDefinedDomains",
49 sig => "conn, int : string array" },
50 { name => "virConnectNumOfNetworks", sig => "conn : int" },
51 { name => "virConnectListNetworks", sig => "conn, int : string array" },
52 { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
53 { name => "virConnectListDefinedNetworks",
54 sig => "conn, int : string array" },
55 { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
56 { name => "virConnectListStoragePools",
57 sig => "conn, int : string array", weak => 1 },
58 { name => "virConnectNumOfDefinedStoragePools",
59 sig => "conn : int", weak => 1 },
60 { name => "virConnectListDefinedStoragePools",
61 sig => "conn, int : string array", weak => 1 },
62 { name => "virConnectGetCapabilities", sig => "conn : string" },
64 { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
65 { name => "virDomainCreateLinuxJob", sig => "conn, string, 0U : job" },
66 { name => "virDomainFree", sig => "dom : free" },
67 { name => "virDomainDestroy", sig => "dom : free" },
68 { name => "virDomainLookupByName", sig => "conn, string : dom" },
69 { name => "virDomainLookupByID", sig => "conn, int : dom" },
70 { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
71 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
72 { name => "virDomainGetName", sig => "dom : static string" },
73 { name => "virDomainGetOSType", sig => "dom : string" },
74 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
75 { name => "virDomainGetUUID", sig => "dom : uuid" },
76 { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
77 { name => "virDomainGetMaxVcpus", sig => "dom : int" },
78 { name => "virDomainSave", sig => "dom, string : unit" },
79 { name => "virDomainSaveJob", sig => "dom, string : job from dom" },
80 { name => "virDomainRestore", sig => "conn, string : unit" },
81 { name => "virDomainRestoreJob", sig => "conn, string : job" },
82 { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
83 { name => "virDomainCoreDumpJob", sig => "dom, string, 0 : job from dom" },
84 { name => "virDomainSuspend", sig => "dom : unit" },
85 { name => "virDomainResume", sig => "dom : unit" },
86 { name => "virDomainShutdown", sig => "dom : unit" },
87 { name => "virDomainReboot", sig => "dom, 0 : unit" },
88 { name => "virDomainDefineXML", sig => "conn, string : dom" },
89 { name => "virDomainUndefine", sig => "dom : unit" },
90 { name => "virDomainCreate", sig => "dom : unit" },
91 { name => "virDomainCreateJob", sig => "dom, 0U : job from dom" },
92 { name => "virDomainAttachDevice", sig => "dom, string : unit" },
93 { name => "virDomainDetachDevice", sig => "dom, string : unit" },
94 { name => "virDomainGetAutostart", sig => "dom : bool" },
95 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
97 { name => "virNetworkFree", sig => "net : free" },
98 { name => "virNetworkDestroy", sig => "net : free" },
99 { name => "virNetworkLookupByName", sig => "conn, string : net" },
100 { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
101 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
102 { name => "virNetworkGetName", sig => "net : static string" },
103 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
104 { name => "virNetworkGetBridgeName", sig => "net : string" },
105 { name => "virNetworkGetUUID", sig => "net : uuid" },
106 { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
107 { name => "virNetworkUndefine", sig => "net : unit" },
108 { name => "virNetworkCreateXML", sig => "conn, string : net" },
109 { name => "virNetworkCreateXMLJob", sig => "conn, string : job" },
110 { name => "virNetworkDefineXML", sig => "conn, string : net" },
111 { name => "virNetworkCreate", sig => "net : unit" },
112 { name => "virNetworkCreateJob", sig => "net : job from net" },
113 { name => "virNetworkGetAutostart", sig => "net : bool" },
114 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
116 { name => "virStoragePoolFree", sig => "pool : free", weak => 1 },
117 { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 },
118 { name => "virStoragePoolLookupByName",
119 sig => "conn, string : pool", weak => 1 },
120 { name => "virStoragePoolLookupByUUID",
121 sig => "conn, uuid : pool", weak => 1 },
122 { name => "virStoragePoolLookupByUUIDString",
123 sig => "conn, string : pool", weak => 1 },
124 { name => "virStoragePoolGetName",
125 sig => "pool : static string", weak => 1 },
126 { name => "virStoragePoolGetXMLDesc",
127 sig => "pool, 0 : string", weak => 1 },
128 { name => "virStoragePoolGetUUID",
129 sig => "pool : uuid", weak => 1 },
130 { name => "virStoragePoolGetUUIDString",
131 sig => "pool : uuid string", weak => 1 },
132 { name => "virStoragePoolCreateXML",
133 sig => "conn, string : pool", weak => 1 },
134 { name => "virStoragePoolDefineXML",
135 sig => "conn, string : pool", weak => 1 },
136 { name => "virStoragePoolUndefine",
137 sig => "pool : unit", weak => 1 },
138 { name => "virStoragePoolCreate",
139 sig => "pool : unit", weak => 1 },
140 { name => "virStoragePoolShutdown",
141 sig => "pool : unit", weak => 1 },
142 { name => "virStoragePoolRefresh",
143 sig => "pool, 0U : unit", weak => 1 },
144 { name => "virStoragePoolGetAutostart",
145 sig => "pool : bool", weak => 1 },
146 { name => "virStoragePoolSetAutostart",
147 sig => "pool, bool : unit", weak => 1 },
149 { name => "virStorageVolFree", sig => "vol : free", weak => 1 },
150 { name => "virStorageVolDestroy", sig => "vol : free", weak => 1 },
151 # { name => "virStorageVolLookupByName", XXX see libvir-list posting
152 # sig => "pool, string : vol", weak => 1 },
153 { name => "virStorageVolLookupByKey",
154 sig => "conn, string : vol", weak => 1 },
155 { name => "virStorageVolLookupByPath",
156 sig => "conn, string : vol", weak => 1 },
157 # { name => "virStorageVolCreateXML",
158 # sig => "pool, string : vol", weak => 1 }, XXX
159 { name => "virStorageVolGetXMLDesc",
160 sig => "vol, 0 : string", weak => 1 },
161 { name => "virStorageVolGetPath",
162 sig => "vol : string", weak => 1 },
163 { name => "virStorageVolGetKey",
164 sig => "vol : static string", weak => 1 },
165 { name => "virStorageVolGetName",
166 sig => "vol : static string", weak => 1 },
167 { name => "virStoragePoolLookupByVolume",
168 sig => "vol : pool from vol", weak => 1 },
170 { name => "virJobFree",
171 sig => "job : free", weak => 1 },
172 { name => "virJobCancel",
173 sig => "job : unit", weak => 1 },
174 { name => "virJobGetNetwork",
175 sig => "job : net from job", weak => 1 },
176 { name => "virJobGetDomain",
177 sig => "job : dom from job", weak => 1 },
181 # Functions we haven't implemented anywhere yet but which are mentioned
184 # We create stubs for these, but eventually they need to either be
185 # moved ^^^ so they are auto-generated, or implementations of them
186 # written in 'libvirt_c_oneoffs.c'.
188 my @unimplemented = (
189 "ocaml_libvirt_storage_pool_get_info",
190 "ocaml_libvirt_storage_vol_lookup_by_name", # XXX see above
191 "ocaml_libvirt_storage_vol_create_xml", # XXX see above
192 "ocaml_libvirt_storage_vol_get_info",
193 "ocaml_libvirt_job_get_info",
196 #----------------------------------------------------------------------
198 # Open the output file.
200 my $filename = "libvirt_c.c";
201 open F, ">$filename" or die "$filename: $!";
203 # Write the prologue.
206 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
208 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
210 * Any changes you make to this file may be overwritten.
213 /* OCaml bindings for libvirt.
214 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
215 * http://libvirt.org/
217 * This library is free software; you can redistribute it and/or
218 * modify it under the terms of the GNU Lesser General Public
219 * License as published by the Free Software Foundation; either
220 * version 2 of the License, or (at your option) any later version.
222 * This library is distributed in the hope that it will be useful,
223 * but WITHOUT ANY WARRANTY; without even the implied warranty of
224 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
225 * Lesser General Public License for more details.
227 * You should have received a copy of the GNU Lesser General Public
228 * License along with this library; if not, write to the Free Software
229 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
238 #include <libvirt/libvirt.h>
239 #include <libvirt/virterror.h>
241 #include <caml/config.h>
242 #include <caml/alloc.h>
243 #include <caml/callback.h>
244 #include <caml/custom.h>
245 #include <caml/fail.h>
246 #include <caml/memory.h>
247 #include <caml/misc.h>
248 #include <caml/mlvalues.h>
249 #include <caml/signals.h>
251 #include "libvirt_c_prologue.c"
253 #include "libvirt_c_oneoffs.c"
257 #----------------------------------------------------------------------
259 sub camel_case_to_underscores
263 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
264 my @subs = split (/,/, $name);
265 @subs = map { lc($_) } @subs;
269 # Helper functions dealing with signatures.
271 sub short_name_to_c_type
275 if ($_ eq "conn") { "virConnectPtr" }
276 elsif ($_ eq "dom") { "virDomainPtr" }
277 elsif ($_ eq "net") { "virNetworkPtr" }
278 elsif ($_ eq "pool") { "virStoragePoolPtr" }
279 elsif ($_ eq "vol") { "virStorageVolPtr" }
280 elsif ($_ eq "job") { "virJobPtr" }
282 die "unknown short name $_"
286 # Generate a C signature for the original function. Used when building
294 if ($sig =~ /^(\w+) : string$/) {
295 my $c_type = short_name_to_c_type ($1);
296 "char *$c_name ($c_type $1)"
297 } elsif ($sig =~ /^(\w+) : static string$/) {
298 my $c_type = short_name_to_c_type ($1);
299 "const char *$c_name ($c_type $1)"
300 } elsif ($sig =~ /^(\w+) : int$/) {
301 my $c_type = short_name_to_c_type ($1);
302 "int $c_name ($c_type $1)"
303 } elsif ($sig =~ /^(\w+) : uuid$/) {
304 my $c_type = short_name_to_c_type ($1);
305 "int $c_name ($c_type $1, unsigned char *)"
306 } elsif ($sig =~ /^(\w+) : uuid string$/) {
307 my $c_type = short_name_to_c_type ($1);
308 "int $c_name ($c_type $1, char *)"
309 } elsif ($sig =~ /^(\w+) : bool$/) {
310 my $c_type = short_name_to_c_type ($1);
311 "int $c_name ($c_type $1, int *r)"
312 } elsif ($sig =~ /^(\w+), bool : unit$/) {
313 my $c_type = short_name_to_c_type ($1);
314 "int $c_name ($c_type $1, int b)"
315 } elsif ($sig eq "conn, int : int array") {
316 "int $c_name (virConnectPtr conn, int *ids, int maxids)"
317 } elsif ($sig eq "conn, int : string array") {
318 "int $c_name (virConnectPtr conn, char **const names, int maxnames)"
319 } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
320 my $c_type = short_name_to_c_type ($1);
321 my $unsigned = $2 eq "U" ? "unsigned " : "";
322 "char *$c_name ($c_type $1, $unsigned int flags)"
323 } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
324 my $c_type = short_name_to_c_type ($1);
325 my $unsigned = $2 eq "U" ? "unsigned " : "";
326 "int $c_name ($c_type $1, $unsigned int flags)"
327 } elsif ($sig =~ /^(\w+) : unit$/) {
328 my $c_type = short_name_to_c_type ($1);
329 "int $c_name ($c_type $1)"
330 } elsif ($sig =~ /^(\w+) : free$/) {
331 my $c_type = short_name_to_c_type ($1);
332 "int $c_name ($c_type $1)"
333 } elsif ($sig =~ /^(\w+), string : unit$/) {
334 my $c_type = short_name_to_c_type ($1);
335 "int $c_name ($c_type $1, const char *str)"
336 } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) {
337 my $c_type = short_name_to_c_type ($1);
338 my $unsigned = $2 eq "U" ? "unsigned " : "";
339 "int $c_name ($c_type $1, const char *str, $unsigned int flags)"
340 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
341 my $c_type = short_name_to_c_type ($1);
342 my $c_ret_type = short_name_to_c_type ($2);
343 "$c_ret_type $c_name ($c_type $1, const char *str)"
344 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) {
345 my $c_type = short_name_to_c_type ($1);
346 my $unsigned = $2 eq "U" ? "unsigned " : "";
347 my $c_ret_type = short_name_to_c_type ($3);
348 "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)"
349 } elsif ($sig =~ /^(\w+), int : (\w+)$/) {
350 my $c_type = short_name_to_c_type ($1);
351 my $c_ret_type = short_name_to_c_type ($2);
352 "$c_ret_type $c_name ($c_type $1, int i)"
353 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
354 my $c_type = short_name_to_c_type ($1);
355 my $c_ret_type = short_name_to_c_type ($2);
356 "$c_ret_type $c_name ($c_type $1, const unsigned char *str)"
357 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) {
358 my $c_type = short_name_to_c_type ($1);
359 my $unsigned = $2 eq "U" ? "unsigned " : "";
360 my $c_ret_type = short_name_to_c_type ($3);
361 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
362 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
363 my $c_type = short_name_to_c_type ($1);
364 my $c_ret_type = short_name_to_c_type ($2);
365 "$c_ret_type $c_name ($c_type $1)"
366 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
367 my $c_type = short_name_to_c_type ($1);
368 my $c_ret_type = short_name_to_c_type ($2);
369 "$c_ret_type $c_name ($c_type $1, const char *str)"
370 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) {
371 my $c_type = short_name_to_c_type ($1);
372 my $unsigned = $2 eq "U" ? "unsigned " : "";
373 my $c_ret_type = short_name_to_c_type ($3);
374 "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)"
375 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) {
376 my $c_type = short_name_to_c_type ($1);
377 my $unsigned = $2 eq "U" ? "unsigned " : "";
378 my $c_ret_type = short_name_to_c_type ($3);
379 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
380 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
381 my $c_type = short_name_to_c_type ($1);
382 my $c_ret_type = short_name_to_c_type ($2);
383 "$c_ret_type $c_name ($c_type $1)"
385 die "unknown signature $sig"
389 # OCaml argument names.
395 if ($sig =~ /^(\w+) : string$/) {
397 } elsif ($sig =~ /^(\w+) : static string$/) {
399 } elsif ($sig =~ /^(\w+) : int$/) {
401 } elsif ($sig =~ /^(\w+) : uuid$/) {
403 } elsif ($sig =~ /^(\w+) : uuid string$/) {
405 } elsif ($sig =~ /^(\w+) : bool$/) {
407 } elsif ($sig =~ /^(\w+), bool : unit$/) {
409 } elsif ($sig eq "conn, int : int array") {
411 } elsif ($sig eq "conn, int : string array") {
413 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
415 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
417 } elsif ($sig =~ /^(\w+) : unit$/) {
419 } elsif ($sig =~ /^(\w+) : free$/) {
421 } elsif ($sig =~ /^(\w+), string : unit$/) {
423 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
425 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
427 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
429 } elsif ($sig =~ /^(\w+), int : (\w+)$/) {
431 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
433 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
435 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
437 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
439 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
441 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
443 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
446 die "unknown signature $sig"
450 # Unpack the first (object) argument.
457 "virConnectPtr conn = Connect_val (connv);"
458 } elsif ($_ eq "dom") {
459 "virDomainPtr dom = Domain_val (domv);\n".
460 " virConnectPtr conn = Connect_domv (domv);"
461 } elsif ($_ eq "net") {
462 "virNetworkPtr net = Network_val (netv);\n".
463 " virConnectPtr conn = Connect_netv (netv);"
464 } elsif ($_ eq "pool") {
465 "virStoragePoolPtr pool = Pool_val (poolv);\n".
466 " virConnectPtr conn = Connect_polv (poolv);"
467 } elsif ($_ eq "vol") {
468 "virStorageVolPtr vol = Volume_val (volv);\n".
469 " virConnectPtr conn = Connect_volv (volv);"
470 } elsif ($_ eq "job") {
471 "virJobPtr job = Job_val (jobv);\n".
472 " virConnectPtr conn = Connect_jobv (jobv);"
474 die "unknown short name $_"
478 # Pack the result if it's an object.
484 if ($_ eq "dom") { "rv = Val_domain (r, connv);" }
485 elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
486 elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
487 elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
488 elsif ($_ eq "job") { "rv = Val_job (r, connv);" }
490 die "unknown short name $_"
498 if ($_ eq "conn") { "Connect_val (connv) = NULL;" }
499 elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" }
500 elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
501 elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
502 elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
503 elsif ($_ eq "job") { "Job_val (jobv) = NULL;" }
505 die "unknown short name $_"
509 # Generate the C body for each signature (class of function).
516 if ($sig =~ /^(\w+) : string$/) {
519 " . gen_unpack_args ($1) . "
522 NONBLOCKING (r = $c_name ($1));
523 CHECK_ERROR (!r, conn, \"$c_name\");
525 rv = caml_copy_string (r);
529 } elsif ($sig =~ /^(\w+) : static string$/) {
532 " . gen_unpack_args ($1) . "
535 NONBLOCKING (r = $c_name ($1));
536 CHECK_ERROR (!r, conn, \"$c_name\");
538 rv = caml_copy_string (r);
541 } elsif ($sig =~ /^(\w+) : int$/) {
543 " . gen_unpack_args ($1) . "
546 NONBLOCKING (r = $c_name ($1));
547 CHECK_ERROR (r == -1, conn, \"$c_name\");
549 CAMLreturn (Val_int (r));
551 } elsif ($sig =~ /^(\w+) : uuid$/) {
554 " . gen_unpack_args ($1) . "
555 unsigned char uuid[VIR_UUID_BUFLEN];
558 NONBLOCKING (r = $c_name ($1, uuid));
559 CHECK_ERROR (r == -1, conn, \"$c_name\");
561 rv = caml_copy_string ((char *) uuid);
564 } elsif ($sig =~ /^(\w+) : uuid string$/) {
567 " . gen_unpack_args ($1) . "
568 char uuid[VIR_UUID_STRING_BUFLEN];
571 NONBLOCKING (r = $c_name ($1, uuid));
572 CHECK_ERROR (r == -1, conn, \"$c_name\");
574 rv = caml_copy_string (uuid);
577 } elsif ($sig =~ /^(\w+) : bool$/) {
579 " . gen_unpack_args ($1) . "
582 NONBLOCKING (r = $c_name ($1, &b));
583 CHECK_ERROR (r == -1, conn, \"$c_name\");
585 CAMLreturn (b ? Val_true : Val_false);
587 } elsif ($sig =~ /^(\w+), bool : unit$/) {
589 " . gen_unpack_args ($1) . "
592 b = bv == Val_true ? 1 : 0;
594 NONBLOCKING (r = $c_name ($1, b));
595 CHECK_ERROR (r == -1, conn, \"$c_name\");
597 CAMLreturn (Val_unit);
599 } elsif ($sig eq "conn, int : int array") {
602 virConnectPtr conn = Connect_val (connv);
603 int i = Int_val (iv);
606 NONBLOCKING (r = $c_name (conn, ids, i));
607 CHECK_ERROR (r == -1, conn, \"$c_name\");
609 rv = caml_alloc (r, 0);
610 for (i = 0; i < r; ++i)
611 Store_field (rv, i, Val_int (ids[i]));
615 } elsif ($sig eq "conn, int : string array") {
617 CAMLlocal2 (rv, strv);
618 virConnectPtr conn = Connect_val (connv);
619 int i = Int_val (iv);
623 NONBLOCKING (r = $c_name (conn, names, i));
624 CHECK_ERROR (r == -1, conn, \"$c_name\");
626 rv = caml_alloc (r, 0);
627 for (i = 0; i < r; ++i) {
628 strv = caml_copy_string (names[i]);
629 Store_field (rv, i, strv);
635 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
638 " . gen_unpack_args ($1) . "
641 NONBLOCKING (r = $c_name ($1, 0));
642 CHECK_ERROR (!r, conn, \"$c_name\");
644 rv = caml_copy_string (r);
648 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
650 " . gen_unpack_args ($1) . "
653 NONBLOCKING (r = $c_name ($1, 0));
654 CHECK_ERROR (r == -1, conn, \"$c_name\");
656 CAMLreturn (Val_unit);
658 } elsif ($sig =~ /^(\w+) : unit$/) {
660 " . gen_unpack_args ($1) . "
663 NONBLOCKING (r = $c_name ($1));
664 CHECK_ERROR (r == -1, conn, \"$c_name\");
666 CAMLreturn (Val_unit);
668 } elsif ($sig =~ /^(\w+) : free$/) {
670 " . gen_unpack_args ($1) . "
673 NONBLOCKING (r = $c_name ($1));
674 CHECK_ERROR (r == -1, conn, \"$c_name\");
676 /* So that we don't double-free in the finalizer: */
677 " . gen_free_arg ($1) . "
679 CAMLreturn (Val_unit);
681 } elsif ($sig =~ /^(\w+), string : unit$/) {
684 " . gen_unpack_args ($1) . "
685 char *str = String_val (strv);
688 NONBLOCKING (r = $c_name ($1, str));
689 CHECK_ERROR (r == -1, conn, \"$c_name\");
691 CAMLreturn (Val_unit);
693 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
696 " . gen_unpack_args ($1) . "
697 char *str = String_val (strv);
700 NONBLOCKING (r = $c_name ($1, str, 0));
701 CHECK_ERROR (!r, conn, \"$c_name\");
703 CAMLreturn (Val_unit);
705 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
706 my $c_ret_type = short_name_to_c_type ($2);
709 " . gen_unpack_args ($1) . "
710 char *str = String_val (strv);
713 NONBLOCKING (r = $c_name ($1, str));
714 CHECK_ERROR (!r, conn, \"$c_name\");
716 " . gen_pack_result ($2) . "
720 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
721 my $c_ret_type = short_name_to_c_type ($2);
724 " . gen_unpack_args ($1) . "
725 char *str = String_val (strv);
728 NONBLOCKING (r = $c_name ($1, str, 0));
729 CHECK_ERROR (!r, conn, \"$c_name\");
731 " . gen_pack_result ($2) . "
735 } elsif ($sig =~ /^(\w+), int : (\w+)$/) {
736 my $c_ret_type = short_name_to_c_type ($2);
739 " . gen_unpack_args ($1) . "
740 int i = Int_val (iv);
743 NONBLOCKING (r = $c_name ($1, i));
744 CHECK_ERROR (!r, conn, \"$c_name\");
746 " . gen_pack_result ($2) . "
750 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
751 my $c_ret_type = short_name_to_c_type ($2);
754 " . gen_unpack_args ($1) . "
755 unsigned char *uuid = (unsigned char *) String_val (uuidv);
758 NONBLOCKING (r = $c_name ($1, uuid));
759 CHECK_ERROR (!r, conn, \"$c_name\");
761 " . gen_pack_result ($2) . "
765 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
766 my $c_ret_type = short_name_to_c_type ($2);
769 " . gen_unpack_args ($1) . "
772 NONBLOCKING (r = $c_name ($1, 0));
773 CHECK_ERROR (!r, conn, \"$c_name\");
775 " . gen_pack_result ($2) . "
779 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
780 my $c_ret_type = short_name_to_c_type ($2);
783 " . gen_unpack_args ($1) . "
786 NONBLOCKING (r = $c_name ($1));
787 CHECK_ERROR (!r, conn, \"$c_name\");
789 " . gen_pack_result ($2) . "
793 } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
794 my $c_ret_type = short_name_to_c_type ($2);
796 CAMLlocal2 (rv, connv);
797 " . gen_unpack_args ($1) . "
798 char *str = String_val (strv);
801 NONBLOCKING (r = $c_name ($1, str));
802 CHECK_ERROR (!r, conn, \"$c_name\");
804 connv = Field ($3v, 1);
805 " . gen_pack_result ($2) . "
809 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
810 my $c_ret_type = short_name_to_c_type ($2);
812 CAMLlocal2 (rv, connv);
813 " . gen_unpack_args ($1) . "
814 char *str = String_val (strv);
817 NONBLOCKING (r = $c_name ($1, str, 0));
818 CHECK_ERROR (!r, conn, \"$c_name\");
820 connv = Field ($3v, 1);
821 " . gen_pack_result ($2) . "
825 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
826 my $c_ret_type = short_name_to_c_type ($2);
828 CAMLlocal2 (rv, connv);
829 " . gen_unpack_args ($1) . "
832 NONBLOCKING (r = $c_name ($1, 0));
833 CHECK_ERROR (!r, conn, \"$c_name\");
835 connv = Field ($3v, 1);
836 " . gen_pack_result ($2) . "
840 } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
841 my $c_ret_type = short_name_to_c_type ($2);
843 CAMLlocal2 (rv, connv);
844 " . gen_unpack_args ($1) . "
847 NONBLOCKING (r = $c_name ($1));
848 CHECK_ERROR (!r, conn, \"$c_name\");
850 connv = Field ($3v, 1);
851 " . gen_pack_result ($2) . "
856 die "unknown signature $sig"
860 # Generate each function.
862 foreach my $function (@functions) {
863 my $c_name = $function->{name};
864 my $is_weak = $function->{weak};
865 my $sig = $function->{sig};
867 my $is_pool_func = $c_name =~ /^virStoragePool/;
868 my $is_vol_func = $c_name =~ /^virStorageVol/;
870 # Generate an equivalent C-external name for the function, unless
871 # one is defined already.
873 if (exists ($function->{c_external_name})) {
874 $c_external_name = $function->{c_external_name};
875 } elsif ($c_name =~ /^vir/) {
876 $c_external_name = substr $c_name, 3;
877 $c_external_name = camel_case_to_underscores ($c_external_name);
878 $c_external_name = "ocaml_libvirt_" . $c_external_name;
880 die "cannot convert c_name $c_name to c_external_name"
883 # Generate a full function prototype if the function is weak.
884 my $have_name = "HAVE_" . uc ($c_name);
886 my $c_sig = gen_c_signature ($sig, $c_name);
888 #ifdef HAVE_WEAK_SYMBOLS
890 extern $c_sig __attribute__((weak));
897 my @arg_names = gen_arg_names ($sig);
898 my $nr_arg_names = scalar @arg_names;
899 my $arg_names = join ", ", @arg_names;
900 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
902 # Generate the start of the function, arguments.
905 $c_external_name ($arg_names_as_values)
907 CAMLparam$nr_arg_names ($arg_names);
910 # If weak, check the function exists at compile time or runtime.
914 /* Symbol $c_name not found at compile time. */
915 not_supported ("$c_name");
916 /* Suppresses a compiler warning. */
919 /* Check that the symbol $c_name
920 * is in runtime version of libvirt.
922 WEAK_SYMBOL_CHECK ($c_name);
926 # Generate the internals of the function.
927 print F (gen_c_code ($sig, $c_name));
929 # Finish off weak #ifdef.
936 # Finish off the function.
943 #----------------------------------------------------------------------
945 # Unimplemented functions.
947 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
949 if (@unimplemented) {
951 /* The following functions are unimplemented and always fail.
952 * See generator.pl '@unimplemented'
957 foreach my $c_external_name (@unimplemented) {
962 failwith ("$c_external_name is unimplemented");
967 } # end if @unimplemented
969 #----------------------------------------------------------------------
971 # Write the epilogue.
974 #include "libvirt_c_epilogue.c"
980 print "$0: written $filename\n"