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 # Please see the file ../COPYING.LIB.
19 # This generates libvirt_c.c (the core of the bindings). You don't
20 # need to run this program unless you are extending the bindings
21 # themselves (eg. because libvirt has been extended).
23 # Please read libvirt/README.
27 #----------------------------------------------------------------------
29 # The functions in the libvirt API that we can generate.
31 # The 'sig' (signature) doesn't have a meaning or any internal structure.
32 # It is interpreted by the generation functions below to indicate what
33 # "class" the function falls into, and to generate the right class of
36 # Any function added since libvirt 0.2.1 must be marked weak.
39 { name => "virConnectClose", sig => "conn : free" },
40 { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
41 { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
42 { name => "virConnectGetType", sig => "conn : static string" },
43 { name => "virConnectNumOfDomains", sig => "conn : int" },
44 { name => "virConnectListDomains", sig => "conn, int : int array" },
45 { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
46 { name => "virConnectListDefinedDomains",
47 sig => "conn, int : string array" },
48 { name => "virConnectNumOfNetworks", sig => "conn : int" },
49 { name => "virConnectListNetworks", sig => "conn, int : string array" },
50 { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
51 { name => "virConnectListDefinedNetworks",
52 sig => "conn, int : string array" },
53 { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
54 { name => "virConnectListStoragePools",
55 sig => "conn, int : string array", weak => 1 },
56 { name => "virConnectNumOfDefinedStoragePools",
57 sig => "conn : int", weak => 1 },
58 { name => "virConnectListDefinedStoragePools",
59 sig => "conn, int : string array", weak => 1 },
60 { name => "virConnectGetCapabilities", sig => "conn : string" },
62 { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
63 { name => "virDomainCreateLinuxJob",
64 sig => "conn, string, 0U : job", weak => 1 },
65 { name => "virDomainFree", sig => "dom : free" },
66 { name => "virDomainDestroy", sig => "dom : free" },
67 { name => "virDomainLookupByName", sig => "conn, string : dom" },
68 { name => "virDomainLookupByID", sig => "conn, int : dom" },
69 { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
70 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
71 { name => "virDomainGetName", sig => "dom : static string" },
72 { name => "virDomainGetOSType", sig => "dom : string" },
73 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
74 { name => "virDomainGetUUID", sig => "dom : uuid" },
75 { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
76 { name => "virDomainGetMaxVcpus", sig => "dom : int" },
77 { name => "virDomainSave", sig => "dom, string : unit" },
78 { name => "virDomainSaveJob",
79 sig => "dom, string : job from dom", weak => 1 },
80 { name => "virDomainRestore", sig => "conn, string : unit" },
81 { name => "virDomainRestoreJob",
82 sig => "conn, string : job", weak => 1 },
83 { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
84 { name => "virDomainCoreDumpJob",
85 sig => "dom, string, 0 : job from dom", weak => 1 },
86 { name => "virDomainSuspend", sig => "dom : unit" },
87 { name => "virDomainResume", sig => "dom : unit" },
88 { name => "virDomainShutdown", sig => "dom : unit" },
89 { name => "virDomainReboot", sig => "dom, 0 : unit" },
90 { name => "virDomainDefineXML", sig => "conn, string : dom" },
91 { name => "virDomainUndefine", sig => "dom : unit" },
92 { name => "virDomainCreate", sig => "dom : unit" },
93 { name => "virDomainCreateJob",
94 sig => "dom, 0U : job from dom", weak => 1 },
95 { name => "virDomainAttachDevice", sig => "dom, string : unit" },
96 { name => "virDomainDetachDevice", sig => "dom, string : unit" },
97 { name => "virDomainGetAutostart", sig => "dom : bool" },
98 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
100 { name => "virNetworkFree", sig => "net : free" },
101 { name => "virNetworkDestroy", sig => "net : free" },
102 { name => "virNetworkLookupByName", sig => "conn, string : net" },
103 { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
104 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
105 { name => "virNetworkGetName", sig => "net : static string" },
106 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
107 { name => "virNetworkGetBridgeName", sig => "net : string" },
108 { name => "virNetworkGetUUID", sig => "net : uuid" },
109 { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
110 { name => "virNetworkUndefine", sig => "net : unit" },
111 { name => "virNetworkCreateXML", sig => "conn, string : net" },
112 { name => "virNetworkCreateXMLJob",
113 sig => "conn, string : job", weak => 1 },
114 { name => "virNetworkDefineXML", sig => "conn, string : net" },
115 { name => "virNetworkCreate", sig => "net : unit" },
116 { name => "virNetworkCreateJob",
117 sig => "net : job from net", weak => 1 },
118 { name => "virNetworkGetAutostart", sig => "net : bool" },
119 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
121 { name => "virStoragePoolFree", sig => "pool : free", weak => 1 },
122 { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 },
123 { name => "virStoragePoolLookupByName",
124 sig => "conn, string : pool", weak => 1 },
125 { name => "virStoragePoolLookupByUUID",
126 sig => "conn, uuid : pool", weak => 1 },
127 { name => "virStoragePoolLookupByUUIDString",
128 sig => "conn, string : pool", weak => 1 },
129 { name => "virStoragePoolGetName",
130 sig => "pool : static string", weak => 1 },
131 { name => "virStoragePoolGetXMLDesc",
132 sig => "pool, 0U : string", weak => 1 },
133 { name => "virStoragePoolGetUUID",
134 sig => "pool : uuid", weak => 1 },
135 { name => "virStoragePoolGetUUIDString",
136 sig => "pool : uuid string", weak => 1 },
137 { name => "virStoragePoolCreateXML",
138 sig => "conn, string, 0U : pool", weak => 1 },
139 { name => "virStoragePoolDefineXML",
140 sig => "conn, string, 0U : pool", weak => 1 },
141 { name => "virStoragePoolBuild",
142 sig => "pool, uint : unit", weak => 1 },
143 { name => "virStoragePoolUndefine",
144 sig => "pool : unit", weak => 1 },
145 { name => "virStoragePoolCreate",
146 sig => "pool, 0U : unit", weak => 1 },
147 { name => "virStoragePoolDelete",
148 sig => "pool, uint : unit", weak => 1 },
149 { name => "virStoragePoolRefresh",
150 sig => "pool, 0U : unit", weak => 1 },
151 { name => "virStoragePoolGetAutostart",
152 sig => "pool : bool", weak => 1 },
153 { name => "virStoragePoolSetAutostart",
154 sig => "pool, bool : unit", weak => 1 },
155 { name => "virStoragePoolNumOfVolumes",
156 sig => "pool : int", weak => 1 },
157 { name => "virStoragePoolListVolumes",
158 sig => "pool, int : string array", weak => 1 },
160 { name => "virStorageVolFree", sig => "vol : free", weak => 1 },
161 { name => "virStorageVolDelete",
162 sig => "vol, uint : unit", weak => 1 },
163 { name => "virStorageVolLookupByName",
164 sig => "pool, string : vol from pool", weak => 1 },
165 { name => "virStorageVolLookupByKey",
166 sig => "conn, string : vol", weak => 1 },
167 { name => "virStorageVolLookupByPath",
168 sig => "conn, string : vol", weak => 1 },
169 { name => "virStorageVolCreateXML",
170 sig => "pool, string, 0U : vol from pool", weak => 1 },
171 { name => "virStorageVolGetXMLDesc",
172 sig => "vol, 0U : string", weak => 1 },
173 { name => "virStorageVolGetPath",
174 sig => "vol : string", weak => 1 },
175 { name => "virStorageVolGetKey",
176 sig => "vol : static string", weak => 1 },
177 { name => "virStorageVolGetName",
178 sig => "vol : static string", weak => 1 },
179 { name => "virStoragePoolLookupByVolume",
180 sig => "vol : pool from vol", weak => 1 },
182 { name => "virJobFree",
183 sig => "job : free", weak => 1 },
184 { name => "virJobCancel",
185 sig => "job : unit", weak => 1 },
186 { name => "virJobGetNetwork",
187 sig => "job : net from job", weak => 1 },
188 { name => "virJobGetDomain",
189 sig => "job : dom from job", weak => 1 },
193 # Functions we haven't implemented anywhere yet but which are mentioned
196 # We create stubs for these, but eventually they need to either be
197 # moved ^^^ so they are auto-generated, or implementations of them
198 # written in 'libvirt_c_oneoffs.c'.
200 my @unimplemented = (
203 #----------------------------------------------------------------------
205 # Open the output file.
207 my $filename = "libvirt_c.c";
208 open F, ">$filename" or die "$filename: $!";
210 # Write the prologue.
213 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
215 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
217 * Any changes you make to this file may be overwritten.
220 /* OCaml bindings for libvirt.
221 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
222 * http://libvirt.org/
224 * This library is free software; you can redistribute it and/or
225 * modify it under the terms of the GNU Lesser General Public
226 * License as published by the Free Software Foundation; either
227 * version 2 of the License, or (at your option) any later version.
229 * This library is distributed in the hope that it will be useful,
230 * but WITHOUT ANY WARRANTY; without even the implied warranty of
231 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
232 * Lesser General Public License for more details.
234 * Please see the file ../COPYING.LIB.
243 #include <libvirt/libvirt.h>
244 #include <libvirt/virterror.h>
246 #include <caml/config.h>
247 #include <caml/alloc.h>
248 #include <caml/callback.h>
249 #include <caml/custom.h>
250 #include <caml/fail.h>
251 #include <caml/memory.h>
252 #include <caml/misc.h>
253 #include <caml/mlvalues.h>
254 #include <caml/signals.h>
256 #include "libvirt_c_prologue.c"
258 #include "libvirt_c_oneoffs.c"
262 #----------------------------------------------------------------------
264 sub camel_case_to_underscores
268 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
269 my @subs = split (/,/, $name);
270 @subs = map { lc($_) } @subs;
274 # Helper functions dealing with signatures.
276 sub short_name_to_c_type
280 if ($_ eq "conn") { "virConnectPtr" }
281 elsif ($_ eq "dom") { "virDomainPtr" }
282 elsif ($_ eq "net") { "virNetworkPtr" }
283 elsif ($_ eq "pool") { "virStoragePoolPtr" }
284 elsif ($_ eq "vol") { "virStorageVolPtr" }
285 elsif ($_ eq "job") { "virJobPtr" }
287 die "unknown short name $_"
291 # Generate a C signature for the original function. Used when building
299 if ($sig =~ /^(\w+) : string$/) {
300 my $c_type = short_name_to_c_type ($1);
301 "char *$c_name ($c_type $1)"
302 } elsif ($sig =~ /^(\w+) : static string$/) {
303 my $c_type = short_name_to_c_type ($1);
304 "const char *$c_name ($c_type $1)"
305 } elsif ($sig =~ /^(\w+) : int$/) {
306 my $c_type = short_name_to_c_type ($1);
307 "int $c_name ($c_type $1)"
308 } elsif ($sig =~ /^(\w+) : uuid$/) {
309 my $c_type = short_name_to_c_type ($1);
310 "int $c_name ($c_type $1, unsigned char *)"
311 } elsif ($sig =~ /^(\w+) : uuid string$/) {
312 my $c_type = short_name_to_c_type ($1);
313 "int $c_name ($c_type $1, char *)"
314 } elsif ($sig =~ /^(\w+) : bool$/) {
315 my $c_type = short_name_to_c_type ($1);
316 "int $c_name ($c_type $1, int *r)"
317 } elsif ($sig =~ /^(\w+), bool : unit$/) {
318 my $c_type = short_name_to_c_type ($1);
319 "int $c_name ($c_type $1, int b)"
320 } elsif ($sig eq "conn, int : int array") {
321 "int $c_name (virConnectPtr conn, int *ids, int maxids)"
322 } elsif ($sig =~ /^(\w+), int : string array$/) {
323 my $c_type = short_name_to_c_type ($1);
324 "int $c_name ($c_type $1, char **const names, int maxnames)"
325 } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
326 my $c_type = short_name_to_c_type ($1);
327 my $unsigned = $2 eq "U" ? "unsigned " : "";
328 "char *$c_name ($c_type $1, $unsigned int flags)"
329 } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
330 my $c_type = short_name_to_c_type ($1);
331 my $unsigned = $2 eq "U" ? "unsigned " : "";
332 "int $c_name ($c_type $1, $unsigned int flags)"
333 } elsif ($sig =~ /^(\w+) : unit$/) {
334 my $c_type = short_name_to_c_type ($1);
335 "int $c_name ($c_type $1)"
336 } elsif ($sig =~ /^(\w+) : free$/) {
337 my $c_type = short_name_to_c_type ($1);
338 "int $c_name ($c_type $1)"
339 } elsif ($sig =~ /^(\w+), string : unit$/) {
340 my $c_type = short_name_to_c_type ($1);
341 "int $c_name ($c_type $1, const char *str)"
342 } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) {
343 my $c_type = short_name_to_c_type ($1);
344 my $unsigned = $2 eq "U" ? "unsigned " : "";
345 "int $c_name ($c_type $1, const char *str, ${unsigned}int flags)"
346 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
347 my $c_type = short_name_to_c_type ($1);
348 my $c_ret_type = short_name_to_c_type ($2);
349 "$c_ret_type $c_name ($c_type $1, const char *str)"
350 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) {
351 my $c_type = short_name_to_c_type ($1);
352 my $unsigned = $2 eq "U" ? "unsigned " : "";
353 my $c_ret_type = short_name_to_c_type ($3);
354 "$c_ret_type $c_name ($c_type $1, const char *str, ${unsigned}int flags)"
355 } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
356 my $c_type = short_name_to_c_type ($1);
357 my $unsigned = $2 eq "u" ? "unsigned " : "";
358 "int $c_name ($c_type $1, ${unsigned}int i)"
359 } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
360 my $c_type = short_name_to_c_type ($1);
361 my $unsigned = $2 eq "u" ? "unsigned " : "";
362 my $c_ret_type = short_name_to_c_type ($3);
363 "$c_ret_type $c_name ($c_type $1, ${unsigned}int i)"
364 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
365 my $c_type = short_name_to_c_type ($1);
366 my $c_ret_type = short_name_to_c_type ($2);
367 "$c_ret_type $c_name ($c_type $1, const unsigned char *str)"
368 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) {
369 my $c_type = short_name_to_c_type ($1);
370 my $unsigned = $2 eq "U" ? "unsigned " : "";
371 my $c_ret_type = short_name_to_c_type ($3);
372 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
373 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
374 my $c_type = short_name_to_c_type ($1);
375 my $c_ret_type = short_name_to_c_type ($2);
376 "$c_ret_type $c_name ($c_type $1)"
377 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
378 my $c_type = short_name_to_c_type ($1);
379 my $c_ret_type = short_name_to_c_type ($2);
380 "$c_ret_type $c_name ($c_type $1, const char *str)"
381 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) {
382 my $c_type = short_name_to_c_type ($1);
383 my $unsigned = $2 eq "U" ? "unsigned " : "";
384 my $c_ret_type = short_name_to_c_type ($3);
385 "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)"
386 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) {
387 my $c_type = short_name_to_c_type ($1);
388 my $unsigned = $2 eq "U" ? "unsigned " : "";
389 my $c_ret_type = short_name_to_c_type ($3);
390 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
391 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
392 my $c_type = short_name_to_c_type ($1);
393 my $c_ret_type = short_name_to_c_type ($2);
394 "$c_ret_type $c_name ($c_type $1)"
396 die "unknown signature $sig"
400 # OCaml argument names.
406 if ($sig =~ /^(\w+) : string$/) {
408 } elsif ($sig =~ /^(\w+) : static string$/) {
410 } elsif ($sig =~ /^(\w+) : int$/) {
412 } elsif ($sig =~ /^(\w+) : uuid$/) {
414 } elsif ($sig =~ /^(\w+) : uuid string$/) {
416 } elsif ($sig =~ /^(\w+) : bool$/) {
418 } elsif ($sig =~ /^(\w+), bool : unit$/) {
420 } elsif ($sig eq "conn, int : int array") {
422 } elsif ($sig =~ /^(\w+), int : string array$/) {
424 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
426 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
428 } elsif ($sig =~ /^(\w+) : unit$/) {
430 } elsif ($sig =~ /^(\w+) : free$/) {
432 } elsif ($sig =~ /^(\w+), string : unit$/) {
434 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
436 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
438 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
440 } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
442 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
444 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
446 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
448 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
450 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
452 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
454 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
457 die "unknown signature $sig"
461 # Unpack the first (object) argument.
468 "virConnectPtr conn = Connect_val (connv);"
469 } elsif ($_ eq "dom") {
470 "virDomainPtr dom = Domain_val (domv);\n".
471 " virConnectPtr conn = Connect_domv (domv);"
472 } elsif ($_ eq "net") {
473 "virNetworkPtr net = Network_val (netv);\n".
474 " virConnectPtr conn = Connect_netv (netv);"
475 } elsif ($_ eq "pool") {
476 "virStoragePoolPtr pool = Pool_val (poolv);\n".
477 " virConnectPtr conn = Connect_polv (poolv);"
478 } elsif ($_ eq "vol") {
479 "virStorageVolPtr vol = Volume_val (volv);\n".
480 " virConnectPtr conn = Connect_volv (volv);"
481 } elsif ($_ eq "job") {
482 "virJobPtr job = Job_val (jobv);\n".
483 " virConnectPtr conn = Connect_jobv (jobv);"
485 die "unknown short name $_"
489 # Pack the result if it's an object.
495 if ($_ eq "dom") { "rv = Val_domain (r, connv);" }
496 elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
497 elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
498 elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
499 elsif ($_ eq "job") { "rv = Val_job (r, connv);" }
501 die "unknown short name $_"
509 if ($_ eq "conn") { "Connect_val (connv) = NULL;" }
510 elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" }
511 elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
512 elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
513 elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
514 elsif ($_ eq "job") { "Job_val (jobv) = NULL;" }
516 die "unknown short name $_"
520 # Generate the C body for each signature (class of function).
527 if ($sig =~ /^(\w+) : string$/) {
530 " . gen_unpack_args ($1) . "
533 NONBLOCKING (r = $c_name ($1));
534 CHECK_ERROR (!r, conn, \"$c_name\");
536 rv = caml_copy_string (r);
540 } elsif ($sig =~ /^(\w+) : static string$/) {
543 " . gen_unpack_args ($1) . "
546 NONBLOCKING (r = $c_name ($1));
547 CHECK_ERROR (!r, conn, \"$c_name\");
549 rv = caml_copy_string (r);
552 } elsif ($sig =~ /^(\w+) : int$/) {
554 " . gen_unpack_args ($1) . "
557 NONBLOCKING (r = $c_name ($1));
558 CHECK_ERROR (r == -1, conn, \"$c_name\");
560 CAMLreturn (Val_int (r));
562 } elsif ($sig =~ /^(\w+) : uuid$/) {
565 " . gen_unpack_args ($1) . "
566 unsigned char uuid[VIR_UUID_BUFLEN];
569 NONBLOCKING (r = $c_name ($1, uuid));
570 CHECK_ERROR (r == -1, conn, \"$c_name\");
572 /* UUIDs are byte arrays with a fixed length. */
573 rv = caml_alloc_string (VIR_UUID_BUFLEN);
574 memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
577 } elsif ($sig =~ /^(\w+) : uuid string$/) {
580 " . gen_unpack_args ($1) . "
581 char uuid[VIR_UUID_STRING_BUFLEN];
584 NONBLOCKING (r = $c_name ($1, uuid));
585 CHECK_ERROR (r == -1, conn, \"$c_name\");
587 rv = caml_copy_string (uuid);
590 } elsif ($sig =~ /^(\w+) : bool$/) {
592 " . gen_unpack_args ($1) . "
595 NONBLOCKING (r = $c_name ($1, &b));
596 CHECK_ERROR (r == -1, conn, \"$c_name\");
598 CAMLreturn (b ? Val_true : Val_false);
600 } elsif ($sig =~ /^(\w+), bool : unit$/) {
602 " . gen_unpack_args ($1) . "
605 b = bv == Val_true ? 1 : 0;
607 NONBLOCKING (r = $c_name ($1, b));
608 CHECK_ERROR (r == -1, conn, \"$c_name\");
610 CAMLreturn (Val_unit);
612 } elsif ($sig eq "conn, int : int array") {
615 virConnectPtr conn = Connect_val (connv);
616 int i = Int_val (iv);
619 /* Some libvirt List* functions still throw exceptions if i == 0,
620 * so catch that and return an empty array directly. This changes
621 * the semantics slightly (masking other failures) but it's
622 * unlikely anyone will care. RWMJ 2008/06/10
625 rv = caml_alloc (0, 0);
629 NONBLOCKING (r = $c_name (conn, ids, i));
630 CHECK_ERROR (r == -1, conn, \"$c_name\");
632 rv = caml_alloc (r, 0);
633 for (i = 0; i < r; ++i)
634 Store_field (rv, i, Val_int (ids[i]));
638 } elsif ($sig =~ /^(\w+), int : string array$/) {
640 CAMLlocal2 (rv, strv);
641 " . gen_unpack_args ($1) . "
642 int i = Int_val (iv);
646 /* Some libvirt List* functions still throw exceptions if i == 0,
647 * so catch that and return an empty array directly. This changes
648 * the semantics slightly (masking other failures) but it's
649 * unlikely anyone will care. RWMJ 2008/06/10
652 rv = caml_alloc (0, 0);
656 NONBLOCKING (r = $c_name ($1, names, i));
657 CHECK_ERROR (r == -1, conn, \"$c_name\");
659 rv = caml_alloc (r, 0);
660 for (i = 0; i < r; ++i) {
661 strv = caml_copy_string (names[i]);
662 Store_field (rv, i, strv);
668 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
671 " . gen_unpack_args ($1) . "
674 NONBLOCKING (r = $c_name ($1, 0));
675 CHECK_ERROR (!r, conn, \"$c_name\");
677 rv = caml_copy_string (r);
681 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
683 " . gen_unpack_args ($1) . "
686 NONBLOCKING (r = $c_name ($1, 0));
687 CHECK_ERROR (r == -1, conn, \"$c_name\");
689 CAMLreturn (Val_unit);
691 } elsif ($sig =~ /^(\w+) : unit$/) {
693 " . gen_unpack_args ($1) . "
696 NONBLOCKING (r = $c_name ($1));
697 CHECK_ERROR (r == -1, conn, \"$c_name\");
699 CAMLreturn (Val_unit);
701 } elsif ($sig =~ /^(\w+) : free$/) {
703 " . gen_unpack_args ($1) . "
706 NONBLOCKING (r = $c_name ($1));
707 CHECK_ERROR (r == -1, conn, \"$c_name\");
709 /* So that we don't double-free in the finalizer: */
710 " . gen_free_arg ($1) . "
712 CAMLreturn (Val_unit);
714 } elsif ($sig =~ /^(\w+), string : unit$/) {
716 " . gen_unpack_args ($1) . "
717 char *str = String_val (strv);
720 NONBLOCKING (r = $c_name ($1, str));
721 CHECK_ERROR (r == -1, conn, \"$c_name\");
723 CAMLreturn (Val_unit);
725 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
728 " . gen_unpack_args ($1) . "
729 char *str = String_val (strv);
732 NONBLOCKING (r = $c_name ($1, str, 0));
733 CHECK_ERROR (!r, conn, \"$c_name\");
735 CAMLreturn (Val_unit);
737 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
738 my $c_ret_type = short_name_to_c_type ($2);
741 " . gen_unpack_args ($1) . "
742 char *str = String_val (strv);
745 NONBLOCKING (r = $c_name ($1, str));
746 CHECK_ERROR (!r, conn, \"$c_name\");
748 " . gen_pack_result ($2) . "
752 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
753 my $c_ret_type = short_name_to_c_type ($2);
756 " . gen_unpack_args ($1) . "
757 char *str = String_val (strv);
760 NONBLOCKING (r = $c_name ($1, str, 0));
761 CHECK_ERROR (!r, conn, \"$c_name\");
763 " . gen_pack_result ($2) . "
767 } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
768 my $unsigned = $2 eq "u" ? "unsigned " : "";
770 " . gen_unpack_args ($1) . "
771 ${unsigned}int i = Int_val (iv);
774 NONBLOCKING (r = $c_name ($1, i));
775 CHECK_ERROR (!r, conn, \"$c_name\");
777 CAMLreturn (Val_unit);
779 } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
780 my $c_ret_type = short_name_to_c_type ($3);
781 my $unsigned = $2 eq "u" ? "unsigned " : "";
784 " . gen_unpack_args ($1) . "
785 ${unsigned}int i = Int_val (iv);
788 NONBLOCKING (r = $c_name ($1, i));
789 CHECK_ERROR (!r, conn, \"$c_name\");
791 " . gen_pack_result ($3) . "
795 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
796 my $c_ret_type = short_name_to_c_type ($2);
799 " . gen_unpack_args ($1) . "
800 unsigned char *uuid = (unsigned char *) String_val (uuidv);
803 NONBLOCKING (r = $c_name ($1, uuid));
804 CHECK_ERROR (!r, conn, \"$c_name\");
806 " . gen_pack_result ($2) . "
810 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
811 my $c_ret_type = short_name_to_c_type ($2);
814 " . gen_unpack_args ($1) . "
817 NONBLOCKING (r = $c_name ($1, 0));
818 CHECK_ERROR (!r, conn, \"$c_name\");
820 " . gen_pack_result ($2) . "
824 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
825 my $c_ret_type = short_name_to_c_type ($2);
828 " . gen_unpack_args ($1) . "
831 NONBLOCKING (r = $c_name ($1));
832 CHECK_ERROR (!r, conn, \"$c_name\");
834 " . gen_pack_result ($2) . "
838 } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
839 my $c_ret_type = short_name_to_c_type ($2);
841 CAMLlocal2 (rv, connv);
842 " . gen_unpack_args ($1) . "
843 char *str = String_val (strv);
846 NONBLOCKING (r = $c_name ($1, str));
847 CHECK_ERROR (!r, conn, \"$c_name\");
849 connv = Field ($3v, 1);
850 " . gen_pack_result ($2) . "
854 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
855 my $c_ret_type = short_name_to_c_type ($2);
857 CAMLlocal2 (rv, connv);
858 " . gen_unpack_args ($1) . "
859 char *str = String_val (strv);
862 NONBLOCKING (r = $c_name ($1, str, 0));
863 CHECK_ERROR (!r, conn, \"$c_name\");
865 connv = Field ($3v, 1);
866 " . gen_pack_result ($2) . "
870 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
871 my $c_ret_type = short_name_to_c_type ($2);
873 CAMLlocal2 (rv, connv);
874 " . gen_unpack_args ($1) . "
877 NONBLOCKING (r = $c_name ($1, 0));
878 CHECK_ERROR (!r, conn, \"$c_name\");
880 connv = Field ($3v, 1);
881 " . gen_pack_result ($2) . "
885 } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
886 my $c_ret_type = short_name_to_c_type ($2);
888 CAMLlocal2 (rv, connv);
889 " . gen_unpack_args ($1) . "
892 NONBLOCKING (r = $c_name ($1));
893 CHECK_ERROR (!r, conn, \"$c_name\");
895 connv = Field ($3v, 1);
896 " . gen_pack_result ($2) . "
901 die "unknown signature $sig"
905 # Generate each function.
907 foreach my $function (@functions) {
908 my $c_name = $function->{name};
909 my $is_weak = $function->{weak};
910 my $sig = $function->{sig};
912 #print "generating $c_name with sig \"$sig\" ...\n";
914 #my $is_pool_func = $c_name =~ /^virStoragePool/;
915 #my $is_vol_func = $c_name =~ /^virStorageVol/;
917 # Generate an equivalent C-external name for the function, unless
918 # one is defined already.
920 if (exists ($function->{c_external_name})) {
921 $c_external_name = $function->{c_external_name};
922 } elsif ($c_name =~ /^vir/) {
923 $c_external_name = substr $c_name, 3;
924 $c_external_name = camel_case_to_underscores ($c_external_name);
925 $c_external_name = "ocaml_libvirt_" . $c_external_name;
927 die "cannot convert c_name $c_name to c_external_name"
931 /* Automatically generated binding for $c_name.
932 * In generator.pl this function has signature "$sig".
937 # Generate a full function prototype if the function is weak.
938 my $have_name = "HAVE_" . uc ($c_name);
940 my $c_sig = gen_c_signature ($sig, $c_name);
942 #ifdef HAVE_WEAK_SYMBOLS
944 extern $c_sig __attribute__((weak));
951 my @arg_names = gen_arg_names ($sig);
952 my $nr_arg_names = scalar @arg_names;
953 my $arg_names = join ", ", @arg_names;
954 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
956 # Generate the start of the function, arguments.
959 $c_external_name ($arg_names_as_values)
961 CAMLparam$nr_arg_names ($arg_names);
964 # If weak, check the function exists at compile time or runtime.
968 /* Symbol $c_name not found at compile time. */
969 not_supported ("$c_name");
972 /* Check that the symbol $c_name
973 * is in runtime version of libvirt.
975 WEAK_SYMBOL_CHECK ($c_name);
979 # Generate the internals of the function.
980 print F (gen_c_code ($sig, $c_name));
982 # Finish off weak #ifdef.
989 # Finish off the function.
996 #----------------------------------------------------------------------
998 # Unimplemented functions.
1000 if (@unimplemented) {
1001 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
1004 /* The following functions are unimplemented and always fail.
1005 * See generator.pl '@unimplemented'
1010 foreach my $c_external_name (@unimplemented) {
1015 failwith ("$c_external_name is unimplemented");
1020 } # end if @unimplemented
1022 #----------------------------------------------------------------------
1024 # Write the epilogue.
1027 #include "libvirt_c_epilogue.c"
1033 print "$0: written $filename\n"