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,
11 # with the OCaml linking exception described in ../COPYING.LIB.
13 # This library is distributed in the hope that it will be useful,
14 # but WITHOUT ANY WARRANTY; without even the implied warranty of
15 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
16 # Lesser General Public License for more details.
18 # You should have received a copy of the GNU Lesser General Public
19 # License along with this library; if not, write to the Free Software
20 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
22 # This generates libvirt_c.c (the core of the bindings). You don't
23 # need to run this program unless you are extending the bindings
24 # themselves (eg. because libvirt has been extended).
26 # Please read libvirt/README.
30 #----------------------------------------------------------------------
32 # The functions in the libvirt API that we can generate.
34 # The 'sig' (signature) doesn't have a meaning or any internal structure.
35 # It is interpreted by the generation functions below to indicate what
36 # "class" the function falls into, and to generate the right class of
39 # Any function added since libvirt 0.2.1 must be marked weak.
42 { name => "virConnectClose", sig => "conn : free" },
43 { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
44 { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
45 { name => "virConnectGetType", sig => "conn : static string" },
46 { name => "virConnectNumOfDomains", sig => "conn : int" },
47 { name => "virConnectListDomains", sig => "conn, int : int array" },
48 { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
49 { name => "virConnectListDefinedDomains",
50 sig => "conn, int : string array" },
51 { name => "virConnectNumOfNetworks", sig => "conn : int" },
52 { name => "virConnectListNetworks", sig => "conn, int : string array" },
53 { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
54 { name => "virConnectListDefinedNetworks",
55 sig => "conn, int : string array" },
56 { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
57 { name => "virConnectListStoragePools",
58 sig => "conn, int : string array", weak => 1 },
59 { name => "virConnectNumOfDefinedStoragePools",
60 sig => "conn : int", weak => 1 },
61 { name => "virConnectListDefinedStoragePools",
62 sig => "conn, int : string array", weak => 1 },
63 { name => "virConnectGetCapabilities", sig => "conn : string" },
65 { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
66 { name => "virDomainCreateLinuxJob",
67 sig => "conn, string, 0U : job", weak => 1 },
68 { name => "virDomainFree", sig => "dom : free" },
69 { name => "virDomainDestroy", sig => "dom : free" },
70 { name => "virDomainLookupByName", sig => "conn, string : dom" },
71 { name => "virDomainLookupByID", sig => "conn, int : dom" },
72 { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
73 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
74 { name => "virDomainGetName", sig => "dom : static string" },
75 { name => "virDomainGetOSType", sig => "dom : string" },
76 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
77 { name => "virDomainGetUUID", sig => "dom : uuid" },
78 { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
79 { name => "virDomainGetMaxVcpus", sig => "dom : int" },
80 { name => "virDomainSave", sig => "dom, string : unit" },
81 { name => "virDomainSaveJob",
82 sig => "dom, string : job from dom", weak => 1 },
83 { name => "virDomainRestore", sig => "conn, string : unit" },
84 { name => "virDomainRestoreJob",
85 sig => "conn, string : job", weak => 1 },
86 { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
87 { name => "virDomainCoreDumpJob",
88 sig => "dom, string, 0 : job from dom", weak => 1 },
89 { name => "virDomainSuspend", sig => "dom : unit" },
90 { name => "virDomainResume", sig => "dom : unit" },
91 { name => "virDomainShutdown", sig => "dom : unit" },
92 { name => "virDomainReboot", sig => "dom, 0 : unit" },
93 { name => "virDomainDefineXML", sig => "conn, string : dom" },
94 { name => "virDomainUndefine", sig => "dom : unit" },
95 { name => "virDomainCreate", sig => "dom : unit" },
96 { name => "virDomainCreateJob",
97 sig => "dom, 0U : job from dom", weak => 1 },
98 { name => "virDomainAttachDevice", sig => "dom, string : unit" },
99 { name => "virDomainDetachDevice", sig => "dom, string : unit" },
100 { name => "virDomainGetAutostart", sig => "dom : bool" },
101 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
103 { name => "virNetworkFree", sig => "net : free" },
104 { name => "virNetworkDestroy", sig => "net : free" },
105 { name => "virNetworkLookupByName", sig => "conn, string : net" },
106 { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
107 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
108 { name => "virNetworkGetName", sig => "net : static string" },
109 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
110 { name => "virNetworkGetBridgeName", sig => "net : string" },
111 { name => "virNetworkGetUUID", sig => "net : uuid" },
112 { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
113 { name => "virNetworkUndefine", sig => "net : unit" },
114 { name => "virNetworkCreateXML", sig => "conn, string : net" },
115 { name => "virNetworkCreateXMLJob",
116 sig => "conn, string : job", weak => 1 },
117 { name => "virNetworkDefineXML", sig => "conn, string : net" },
118 { name => "virNetworkCreate", sig => "net : unit" },
119 { name => "virNetworkCreateJob",
120 sig => "net : job from net", weak => 1 },
121 { name => "virNetworkGetAutostart", sig => "net : bool" },
122 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
124 { name => "virStoragePoolFree", sig => "pool : free", weak => 1 },
125 { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 },
126 { name => "virStoragePoolLookupByName",
127 sig => "conn, string : pool", weak => 1 },
128 { name => "virStoragePoolLookupByUUID",
129 sig => "conn, uuid : pool", weak => 1 },
130 { name => "virStoragePoolLookupByUUIDString",
131 sig => "conn, string : pool", weak => 1 },
132 { name => "virStoragePoolGetName",
133 sig => "pool : static string", weak => 1 },
134 { name => "virStoragePoolGetXMLDesc",
135 sig => "pool, 0U : string", weak => 1 },
136 { name => "virStoragePoolGetUUID",
137 sig => "pool : uuid", weak => 1 },
138 { name => "virStoragePoolGetUUIDString",
139 sig => "pool : uuid string", weak => 1 },
140 { name => "virStoragePoolCreateXML",
141 sig => "conn, string, 0U : pool", weak => 1 },
142 { name => "virStoragePoolDefineXML",
143 sig => "conn, string, 0U : pool", weak => 1 },
144 { name => "virStoragePoolBuild",
145 sig => "pool, uint : unit", weak => 1 },
146 { name => "virStoragePoolUndefine",
147 sig => "pool : unit", weak => 1 },
148 { name => "virStoragePoolCreate",
149 sig => "pool, 0U : unit", weak => 1 },
150 { name => "virStoragePoolDelete",
151 sig => "pool, uint : unit", weak => 1 },
152 { name => "virStoragePoolRefresh",
153 sig => "pool, 0U : unit", weak => 1 },
154 { name => "virStoragePoolGetAutostart",
155 sig => "pool : bool", weak => 1 },
156 { name => "virStoragePoolSetAutostart",
157 sig => "pool, bool : unit", weak => 1 },
158 { name => "virStoragePoolNumOfVolumes",
159 sig => "pool : int", weak => 1 },
160 { name => "virStoragePoolListVolumes",
161 sig => "pool, int : string array", weak => 1 },
163 { name => "virStorageVolFree", sig => "vol : free", weak => 1 },
164 { name => "virStorageVolDelete",
165 sig => "vol, uint : unit", weak => 1 },
166 { name => "virStorageVolLookupByName",
167 sig => "pool, string : vol from pool", weak => 1 },
168 { name => "virStorageVolLookupByKey",
169 sig => "conn, string : vol", weak => 1 },
170 { name => "virStorageVolLookupByPath",
171 sig => "conn, string : vol", weak => 1 },
172 { name => "virStorageVolCreateXML",
173 sig => "pool, string, 0U : vol from pool", weak => 1 },
174 { name => "virStorageVolGetXMLDesc",
175 sig => "vol, 0U : string", weak => 1 },
176 { name => "virStorageVolGetPath",
177 sig => "vol : string", weak => 1 },
178 { name => "virStorageVolGetKey",
179 sig => "vol : static string", weak => 1 },
180 { name => "virStorageVolGetName",
181 sig => "vol : static string", weak => 1 },
182 { name => "virStoragePoolLookupByVolume",
183 sig => "vol : pool from vol", weak => 1 },
185 { name => "virJobFree",
186 sig => "job : free", weak => 1 },
187 { name => "virJobCancel",
188 sig => "job : unit", weak => 1 },
189 { name => "virJobGetNetwork",
190 sig => "job : net from job", weak => 1 },
191 { name => "virJobGetDomain",
192 sig => "job : dom from job", weak => 1 },
196 # Functions we haven't implemented anywhere yet but which are mentioned
199 # We create stubs for these, but eventually they need to either be
200 # moved ^^^ so they are auto-generated, or implementations of them
201 # written in 'libvirt_c_oneoffs.c'.
203 my @unimplemented = (
206 #----------------------------------------------------------------------
208 # Open the output file.
210 my $filename = "libvirt_c.c";
211 open F, ">$filename" or die "$filename: $!";
213 # Write the prologue.
216 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
218 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
220 * Any changes you make to this file may be overwritten.
223 /* OCaml bindings for libvirt.
224 * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
225 * http://libvirt.org/
227 * This library is free software; you can redistribute it and/or
228 * modify it under the terms of the GNU Lesser General Public
229 * License as published by the Free Software Foundation; either
230 * version 2 of the License, or (at your option) any later version,
231 * with the OCaml linking exception described in ../COPYING.LIB.
233 * This library is distributed in the hope that it will be useful,
234 * but WITHOUT ANY WARRANTY; without even the implied warranty of
235 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
236 * Lesser General Public License for more details.
238 * You should have received a copy of the GNU Lesser General Public
239 * License along with this library; if not, write to the Free Software
240 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
249 #include <libvirt/libvirt.h>
250 #include <libvirt/virterror.h>
252 #include <caml/config.h>
253 #include <caml/alloc.h>
254 #include <caml/callback.h>
255 #include <caml/custom.h>
256 #include <caml/fail.h>
257 #include <caml/memory.h>
258 #include <caml/misc.h>
259 #include <caml/mlvalues.h>
260 #include <caml/signals.h>
262 #include "libvirt_c_prologue.c"
264 #include "libvirt_c_oneoffs.c"
268 #----------------------------------------------------------------------
270 sub camel_case_to_underscores
274 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
275 my @subs = split (/,/, $name);
276 @subs = map { lc($_) } @subs;
280 # Helper functions dealing with signatures.
282 sub short_name_to_c_type
286 if ($_ eq "conn") { "virConnectPtr" }
287 elsif ($_ eq "dom") { "virDomainPtr" }
288 elsif ($_ eq "net") { "virNetworkPtr" }
289 elsif ($_ eq "pool") { "virStoragePoolPtr" }
290 elsif ($_ eq "vol") { "virStorageVolPtr" }
291 elsif ($_ eq "job") { "virJobPtr" }
293 die "unknown short name $_"
297 # Generate a C signature for the original function. Used when building
305 if ($sig =~ /^(\w+) : string$/) {
306 my $c_type = short_name_to_c_type ($1);
307 "char *$c_name ($c_type $1)"
308 } elsif ($sig =~ /^(\w+) : static string$/) {
309 my $c_type = short_name_to_c_type ($1);
310 "const char *$c_name ($c_type $1)"
311 } elsif ($sig =~ /^(\w+) : int$/) {
312 my $c_type = short_name_to_c_type ($1);
313 "int $c_name ($c_type $1)"
314 } elsif ($sig =~ /^(\w+) : uuid$/) {
315 my $c_type = short_name_to_c_type ($1);
316 "int $c_name ($c_type $1, unsigned char *)"
317 } elsif ($sig =~ /^(\w+) : uuid string$/) {
318 my $c_type = short_name_to_c_type ($1);
319 "int $c_name ($c_type $1, char *)"
320 } elsif ($sig =~ /^(\w+) : bool$/) {
321 my $c_type = short_name_to_c_type ($1);
322 "int $c_name ($c_type $1, int *r)"
323 } elsif ($sig =~ /^(\w+), bool : unit$/) {
324 my $c_type = short_name_to_c_type ($1);
325 "int $c_name ($c_type $1, int b)"
326 } elsif ($sig eq "conn, int : int array") {
327 "int $c_name (virConnectPtr conn, int *ids, int maxids)"
328 } elsif ($sig =~ /^(\w+), int : string array$/) {
329 my $c_type = short_name_to_c_type ($1);
330 "int $c_name ($c_type $1, char **const names, int maxnames)"
331 } elsif ($sig =~ /^(\w+), 0(U?) : string$/) {
332 my $c_type = short_name_to_c_type ($1);
333 my $unsigned = $2 eq "U" ? "unsigned " : "";
334 "char *$c_name ($c_type $1, $unsigned int flags)"
335 } elsif ($sig =~ /^(\w+), 0(U?) : unit$/) {
336 my $c_type = short_name_to_c_type ($1);
337 my $unsigned = $2 eq "U" ? "unsigned " : "";
338 "int $c_name ($c_type $1, $unsigned int flags)"
339 } elsif ($sig =~ /^(\w+) : unit$/) {
340 my $c_type = short_name_to_c_type ($1);
341 "int $c_name ($c_type $1)"
342 } elsif ($sig =~ /^(\w+) : free$/) {
343 my $c_type = short_name_to_c_type ($1);
344 "int $c_name ($c_type $1)"
345 } elsif ($sig =~ /^(\w+), string : unit$/) {
346 my $c_type = short_name_to_c_type ($1);
347 "int $c_name ($c_type $1, const char *str)"
348 } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) {
349 my $c_type = short_name_to_c_type ($1);
350 my $unsigned = $2 eq "U" ? "unsigned " : "";
351 "int $c_name ($c_type $1, const char *str, ${unsigned}int flags)"
352 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
353 my $c_type = short_name_to_c_type ($1);
354 my $c_ret_type = short_name_to_c_type ($2);
355 "$c_ret_type $c_name ($c_type $1, const char *str)"
356 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) {
357 my $c_type = short_name_to_c_type ($1);
358 my $unsigned = $2 eq "U" ? "unsigned " : "";
359 my $c_ret_type = short_name_to_c_type ($3);
360 "$c_ret_type $c_name ($c_type $1, const char *str, ${unsigned}int flags)"
361 } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
362 my $c_type = short_name_to_c_type ($1);
363 my $unsigned = $2 eq "u" ? "unsigned " : "";
364 "int $c_name ($c_type $1, ${unsigned}int i)"
365 } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
366 my $c_type = short_name_to_c_type ($1);
367 my $unsigned = $2 eq "u" ? "unsigned " : "";
368 my $c_ret_type = short_name_to_c_type ($3);
369 "$c_ret_type $c_name ($c_type $1, ${unsigned}int i)"
370 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
371 my $c_type = short_name_to_c_type ($1);
372 my $c_ret_type = short_name_to_c_type ($2);
373 "$c_ret_type $c_name ($c_type $1, const unsigned char *str)"
374 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) {
375 my $c_type = short_name_to_c_type ($1);
376 my $unsigned = $2 eq "U" ? "unsigned " : "";
377 my $c_ret_type = short_name_to_c_type ($3);
378 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
379 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
380 my $c_type = short_name_to_c_type ($1);
381 my $c_ret_type = short_name_to_c_type ($2);
382 "$c_ret_type $c_name ($c_type $1)"
383 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
384 my $c_type = short_name_to_c_type ($1);
385 my $c_ret_type = short_name_to_c_type ($2);
386 "$c_ret_type $c_name ($c_type $1, const char *str)"
387 } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) {
388 my $c_type = short_name_to_c_type ($1);
389 my $unsigned = $2 eq "U" ? "unsigned " : "";
390 my $c_ret_type = short_name_to_c_type ($3);
391 "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)"
392 } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) {
393 my $c_type = short_name_to_c_type ($1);
394 my $unsigned = $2 eq "U" ? "unsigned " : "";
395 my $c_ret_type = short_name_to_c_type ($3);
396 "$c_ret_type $c_name ($c_type $1, $unsigned int flags)"
397 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
398 my $c_type = short_name_to_c_type ($1);
399 my $c_ret_type = short_name_to_c_type ($2);
400 "$c_ret_type $c_name ($c_type $1)"
402 die "unknown signature $sig"
406 # OCaml argument names.
412 if ($sig =~ /^(\w+) : string$/) {
414 } elsif ($sig =~ /^(\w+) : static string$/) {
416 } elsif ($sig =~ /^(\w+) : int$/) {
418 } elsif ($sig =~ /^(\w+) : uuid$/) {
420 } elsif ($sig =~ /^(\w+) : uuid string$/) {
422 } elsif ($sig =~ /^(\w+) : bool$/) {
424 } elsif ($sig =~ /^(\w+), bool : unit$/) {
426 } elsif ($sig eq "conn, int : int array") {
428 } elsif ($sig =~ /^(\w+), int : string array$/) {
430 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
432 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
434 } elsif ($sig =~ /^(\w+) : unit$/) {
436 } elsif ($sig =~ /^(\w+) : free$/) {
438 } elsif ($sig =~ /^(\w+), string : unit$/) {
440 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
442 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
444 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
446 } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
448 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
450 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
452 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
454 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
456 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
458 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
460 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
463 die "unknown signature $sig"
467 # Unpack the first (object) argument.
474 "virConnectPtr conn = Connect_val (connv);"
475 } elsif ($_ eq "dom") {
476 "virDomainPtr dom = Domain_val (domv);\n".
477 " virConnectPtr conn = Connect_domv (domv);"
478 } elsif ($_ eq "net") {
479 "virNetworkPtr net = Network_val (netv);\n".
480 " virConnectPtr conn = Connect_netv (netv);"
481 } elsif ($_ eq "pool") {
482 "virStoragePoolPtr pool = Pool_val (poolv);\n".
483 " virConnectPtr conn = Connect_polv (poolv);"
484 } elsif ($_ eq "vol") {
485 "virStorageVolPtr vol = Volume_val (volv);\n".
486 " virConnectPtr conn = Connect_volv (volv);"
487 } elsif ($_ eq "job") {
488 "virJobPtr job = Job_val (jobv);\n".
489 " virConnectPtr conn = Connect_jobv (jobv);"
491 die "unknown short name $_"
495 # Pack the result if it's an object.
501 if ($_ eq "dom") { "rv = Val_domain (r, connv);" }
502 elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
503 elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
504 elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
505 elsif ($_ eq "job") { "rv = Val_job (r, connv);" }
507 die "unknown short name $_"
515 if ($_ eq "conn") { "Connect_val (connv) = NULL;" }
516 elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" }
517 elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
518 elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
519 elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
520 elsif ($_ eq "job") { "Job_val (jobv) = NULL;" }
522 die "unknown short name $_"
526 # Generate the C body for each signature (class of function).
533 if ($sig =~ /^(\w+) : string$/) {
536 " . gen_unpack_args ($1) . "
539 NONBLOCKING (r = $c_name ($1));
540 CHECK_ERROR (!r, conn, \"$c_name\");
542 rv = caml_copy_string (r);
546 } elsif ($sig =~ /^(\w+) : static string$/) {
549 " . gen_unpack_args ($1) . "
552 NONBLOCKING (r = $c_name ($1));
553 CHECK_ERROR (!r, conn, \"$c_name\");
555 rv = caml_copy_string (r);
558 } elsif ($sig =~ /^(\w+) : int$/) {
560 " . gen_unpack_args ($1) . "
563 NONBLOCKING (r = $c_name ($1));
564 CHECK_ERROR (r == -1, conn, \"$c_name\");
566 CAMLreturn (Val_int (r));
568 } elsif ($sig =~ /^(\w+) : uuid$/) {
571 " . gen_unpack_args ($1) . "
572 unsigned char uuid[VIR_UUID_BUFLEN];
575 NONBLOCKING (r = $c_name ($1, uuid));
576 CHECK_ERROR (r == -1, conn, \"$c_name\");
578 /* UUIDs are byte arrays with a fixed length. */
579 rv = caml_alloc_string (VIR_UUID_BUFLEN);
580 memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
583 } elsif ($sig =~ /^(\w+) : uuid string$/) {
586 " . gen_unpack_args ($1) . "
587 char uuid[VIR_UUID_STRING_BUFLEN];
590 NONBLOCKING (r = $c_name ($1, uuid));
591 CHECK_ERROR (r == -1, conn, \"$c_name\");
593 rv = caml_copy_string (uuid);
596 } elsif ($sig =~ /^(\w+) : bool$/) {
598 " . gen_unpack_args ($1) . "
601 NONBLOCKING (r = $c_name ($1, &b));
602 CHECK_ERROR (r == -1, conn, \"$c_name\");
604 CAMLreturn (b ? Val_true : Val_false);
606 } elsif ($sig =~ /^(\w+), bool : unit$/) {
608 " . gen_unpack_args ($1) . "
611 b = bv == Val_true ? 1 : 0;
613 NONBLOCKING (r = $c_name ($1, b));
614 CHECK_ERROR (r == -1, conn, \"$c_name\");
616 CAMLreturn (Val_unit);
618 } elsif ($sig eq "conn, int : int array") {
621 virConnectPtr conn = Connect_val (connv);
622 int i = Int_val (iv);
625 /* Some libvirt List* functions still throw exceptions if i == 0,
626 * so catch that and return an empty array directly. This changes
627 * the semantics slightly (masking other failures) but it's
628 * unlikely anyone will care. RWMJ 2008/06/10
631 rv = caml_alloc (0, 0);
635 NONBLOCKING (r = $c_name (conn, ids, i));
636 CHECK_ERROR (r == -1, conn, \"$c_name\");
638 rv = caml_alloc (r, 0);
639 for (i = 0; i < r; ++i)
640 Store_field (rv, i, Val_int (ids[i]));
644 } elsif ($sig =~ /^(\w+), int : string array$/) {
646 CAMLlocal2 (rv, strv);
647 " . gen_unpack_args ($1) . "
648 int i = Int_val (iv);
652 /* Some libvirt List* functions still throw exceptions if i == 0,
653 * so catch that and return an empty array directly. This changes
654 * the semantics slightly (masking other failures) but it's
655 * unlikely anyone will care. RWMJ 2008/06/10
658 rv = caml_alloc (0, 0);
662 NONBLOCKING (r = $c_name ($1, names, i));
663 CHECK_ERROR (r == -1, conn, \"$c_name\");
665 rv = caml_alloc (r, 0);
666 for (i = 0; i < r; ++i) {
667 strv = caml_copy_string (names[i]);
668 Store_field (rv, i, strv);
674 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
677 " . gen_unpack_args ($1) . "
680 NONBLOCKING (r = $c_name ($1, 0));
681 CHECK_ERROR (!r, conn, \"$c_name\");
683 rv = caml_copy_string (r);
687 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
689 " . gen_unpack_args ($1) . "
692 NONBLOCKING (r = $c_name ($1, 0));
693 CHECK_ERROR (r == -1, conn, \"$c_name\");
695 CAMLreturn (Val_unit);
697 } elsif ($sig =~ /^(\w+) : unit$/) {
699 " . gen_unpack_args ($1) . "
702 NONBLOCKING (r = $c_name ($1));
703 CHECK_ERROR (r == -1, conn, \"$c_name\");
705 CAMLreturn (Val_unit);
707 } elsif ($sig =~ /^(\w+) : free$/) {
709 " . gen_unpack_args ($1) . "
712 NONBLOCKING (r = $c_name ($1));
713 CHECK_ERROR (r == -1, conn, \"$c_name\");
715 /* So that we don't double-free in the finalizer: */
716 " . gen_free_arg ($1) . "
718 CAMLreturn (Val_unit);
720 } elsif ($sig =~ /^(\w+), string : unit$/) {
722 " . gen_unpack_args ($1) . "
723 char *str = String_val (strv);
726 NONBLOCKING (r = $c_name ($1, str));
727 CHECK_ERROR (r == -1, conn, \"$c_name\");
729 CAMLreturn (Val_unit);
731 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
734 " . gen_unpack_args ($1) . "
735 char *str = String_val (strv);
738 NONBLOCKING (r = $c_name ($1, str, 0));
739 CHECK_ERROR (!r, conn, \"$c_name\");
741 CAMLreturn (Val_unit);
743 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
744 my $c_ret_type = short_name_to_c_type ($2);
747 " . gen_unpack_args ($1) . "
748 char *str = String_val (strv);
751 NONBLOCKING (r = $c_name ($1, str));
752 CHECK_ERROR (!r, conn, \"$c_name\");
754 " . gen_pack_result ($2) . "
758 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
759 my $c_ret_type = short_name_to_c_type ($2);
762 " . gen_unpack_args ($1) . "
763 char *str = String_val (strv);
766 NONBLOCKING (r = $c_name ($1, str, 0));
767 CHECK_ERROR (!r, conn, \"$c_name\");
769 " . gen_pack_result ($2) . "
773 } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
774 my $unsigned = $2 eq "u" ? "unsigned " : "";
776 " . gen_unpack_args ($1) . "
777 ${unsigned}int i = Int_val (iv);
780 NONBLOCKING (r = $c_name ($1, i));
781 CHECK_ERROR (!r, conn, \"$c_name\");
783 CAMLreturn (Val_unit);
785 } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
786 my $c_ret_type = short_name_to_c_type ($3);
787 my $unsigned = $2 eq "u" ? "unsigned " : "";
790 " . gen_unpack_args ($1) . "
791 ${unsigned}int i = Int_val (iv);
794 NONBLOCKING (r = $c_name ($1, i));
795 CHECK_ERROR (!r, conn, \"$c_name\");
797 " . gen_pack_result ($3) . "
801 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
802 my $c_ret_type = short_name_to_c_type ($2);
805 " . gen_unpack_args ($1) . "
806 unsigned char *uuid = (unsigned char *) String_val (uuidv);
809 NONBLOCKING (r = $c_name ($1, uuid));
810 CHECK_ERROR (!r, conn, \"$c_name\");
812 " . gen_pack_result ($2) . "
816 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
817 my $c_ret_type = short_name_to_c_type ($2);
820 " . gen_unpack_args ($1) . "
823 NONBLOCKING (r = $c_name ($1, 0));
824 CHECK_ERROR (!r, conn, \"$c_name\");
826 " . gen_pack_result ($2) . "
830 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
831 my $c_ret_type = short_name_to_c_type ($2);
834 " . gen_unpack_args ($1) . "
837 NONBLOCKING (r = $c_name ($1));
838 CHECK_ERROR (!r, conn, \"$c_name\");
840 " . gen_pack_result ($2) . "
844 } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
845 my $c_ret_type = short_name_to_c_type ($2);
847 CAMLlocal2 (rv, connv);
848 " . gen_unpack_args ($1) . "
849 char *str = String_val (strv);
852 NONBLOCKING (r = $c_name ($1, str));
853 CHECK_ERROR (!r, conn, \"$c_name\");
855 connv = Field ($3v, 1);
856 " . gen_pack_result ($2) . "
860 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
861 my $c_ret_type = short_name_to_c_type ($2);
863 CAMLlocal2 (rv, connv);
864 " . gen_unpack_args ($1) . "
865 char *str = String_val (strv);
868 NONBLOCKING (r = $c_name ($1, str, 0));
869 CHECK_ERROR (!r, conn, \"$c_name\");
871 connv = Field ($3v, 1);
872 " . gen_pack_result ($2) . "
876 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
877 my $c_ret_type = short_name_to_c_type ($2);
879 CAMLlocal2 (rv, connv);
880 " . gen_unpack_args ($1) . "
883 NONBLOCKING (r = $c_name ($1, 0));
884 CHECK_ERROR (!r, conn, \"$c_name\");
886 connv = Field ($3v, 1);
887 " . gen_pack_result ($2) . "
891 } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
892 my $c_ret_type = short_name_to_c_type ($2);
894 CAMLlocal2 (rv, connv);
895 " . gen_unpack_args ($1) . "
898 NONBLOCKING (r = $c_name ($1));
899 CHECK_ERROR (!r, conn, \"$c_name\");
901 connv = Field ($3v, 1);
902 " . gen_pack_result ($2) . "
907 die "unknown signature $sig"
911 # Generate each function.
913 foreach my $function (@functions) {
914 my $c_name = $function->{name};
915 my $is_weak = $function->{weak};
916 my $sig = $function->{sig};
918 #print "generating $c_name with sig \"$sig\" ...\n";
920 #my $is_pool_func = $c_name =~ /^virStoragePool/;
921 #my $is_vol_func = $c_name =~ /^virStorageVol/;
923 # Generate an equivalent C-external name for the function, unless
924 # one is defined already.
926 if (exists ($function->{c_external_name})) {
927 $c_external_name = $function->{c_external_name};
928 } elsif ($c_name =~ /^vir/) {
929 $c_external_name = substr $c_name, 3;
930 $c_external_name = camel_case_to_underscores ($c_external_name);
931 $c_external_name = "ocaml_libvirt_" . $c_external_name;
933 die "cannot convert c_name $c_name to c_external_name"
937 /* Automatically generated binding for $c_name.
938 * In generator.pl this function has signature "$sig".
943 # Generate a full function prototype if the function is weak.
944 my $have_name = "HAVE_" . uc ($c_name);
946 my $c_sig = gen_c_signature ($sig, $c_name);
948 #ifdef HAVE_WEAK_SYMBOLS
950 extern $c_sig __attribute__((weak));
957 my @arg_names = gen_arg_names ($sig);
958 my $nr_arg_names = scalar @arg_names;
959 my $arg_names = join ", ", @arg_names;
960 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
962 # Generate the start of the function, arguments.
965 $c_external_name ($arg_names_as_values)
967 CAMLparam$nr_arg_names ($arg_names);
970 # If weak, check the function exists at compile time or runtime.
974 /* Symbol $c_name not found at compile time. */
975 not_supported ("$c_name");
978 /* Check that the symbol $c_name
979 * is in runtime version of libvirt.
981 WEAK_SYMBOL_CHECK ($c_name);
985 # Generate the internals of the function.
986 print F (gen_c_code ($sig, $c_name));
988 # Finish off weak #ifdef.
995 # Finish off the function.
1002 #----------------------------------------------------------------------
1004 # Unimplemented functions.
1006 if (@unimplemented) {
1007 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
1010 /* The following functions are unimplemented and always fail.
1011 * See generator.pl '@unimplemented'
1016 foreach my $c_external_name (@unimplemented) {
1021 failwith ("$c_external_name is unimplemented");
1026 } # end if @unimplemented
1028 #----------------------------------------------------------------------
1030 # Write the epilogue.
1033 #include "libvirt_c_epilogue.c"
1039 print "$0: written $filename\n"