3 # OCaml bindings for libvirt.
4 # (C) Copyright 2007-2015 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
40 { name => "virConnectClose", sig => "conn : free" },
41 { name => "virConnectGetHostname", sig => "conn : string" },
42 { name => "virConnectGetURI", sig => "conn : string" },
43 { name => "virConnectGetType", sig => "conn : static string" },
44 { name => "virConnectNumOfDomains", sig => "conn : int" },
45 { name => "virConnectListDomains", sig => "conn, int : int array" },
46 { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
47 { name => "virConnectListDefinedDomains",
48 sig => "conn, int : string array" },
49 { name => "virConnectNumOfNetworks", sig => "conn : int" },
50 { name => "virConnectListNetworks", sig => "conn, int : string array" },
51 { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
52 { name => "virConnectListDefinedNetworks",
53 sig => "conn, int : string array" },
54 { name => "virConnectNumOfStoragePools", sig => "conn : int" },
55 { name => "virConnectListStoragePools",
56 sig => "conn, int : string array" },
57 { name => "virConnectNumOfDefinedStoragePools",
58 sig => "conn : int" },
59 { name => "virConnectListDefinedStoragePools",
60 sig => "conn, int : string array" },
61 { name => "virConnectNumOfSecrets", sig => "conn : int" },
62 { name => "virConnectListSecrets", sig => "conn, int : string array" },
63 { name => "virConnectGetCapabilities", sig => "conn : string" },
64 { name => "virConnectDomainEventDeregisterAny",
65 sig => "conn, int : unit" },
67 { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
68 { name => "virDomainCreateXML", sig => "conn, string, unsigned : dom" },
69 { name => "virDomainFree", sig => "dom : free" },
70 { name => "virDomainDestroy", sig => "dom : free" },
71 { name => "virDomainLookupByName", sig => "conn, string : dom" },
72 { name => "virDomainLookupByID", sig => "conn, int : dom" },
73 { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
74 { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
75 { name => "virDomainGetName", sig => "dom : static string" },
76 { name => "virDomainGetOSType", sig => "dom : string" },
77 { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
78 { name => "virDomainGetUUID", sig => "dom : uuid" },
79 { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
80 { name => "virDomainGetMaxVcpus", sig => "dom : int" },
81 { name => "virDomainSave", sig => "dom, string : unit" },
82 { name => "virDomainRestore", sig => "conn, string : unit" },
83 { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
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 => "virDomainAttachDevice", sig => "dom, string : unit" },
92 { name => "virDomainDetachDevice", sig => "dom, string : unit" },
93 { name => "virDomainGetAutostart", sig => "dom : bool" },
94 { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
96 { name => "virNetworkFree", sig => "net : free" },
97 { name => "virNetworkDestroy", sig => "net : free" },
98 { name => "virNetworkLookupByName", sig => "conn, string : net" },
99 { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
100 { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
101 { name => "virNetworkGetName", sig => "net : static string" },
102 { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
103 { name => "virNetworkGetBridgeName", sig => "net : string" },
104 { name => "virNetworkGetUUID", sig => "net : uuid" },
105 { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
106 { name => "virNetworkUndefine", sig => "net : unit" },
107 { name => "virNetworkCreateXML", sig => "conn, string : net" },
108 { name => "virNetworkDefineXML", sig => "conn, string : net" },
109 { name => "virNetworkCreate", sig => "net : unit" },
110 { name => "virNetworkGetAutostart", sig => "net : bool" },
111 { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
113 { name => "virStoragePoolFree", sig => "pool : free" },
114 { name => "virStoragePoolDestroy", sig => "pool : free" },
115 { name => "virStoragePoolLookupByName",
116 sig => "conn, string : pool" },
117 { name => "virStoragePoolLookupByUUID",
118 sig => "conn, uuid : pool" },
119 { name => "virStoragePoolLookupByUUIDString",
120 sig => "conn, string : pool" },
121 { name => "virStoragePoolGetName",
122 sig => "pool : static string" },
123 { name => "virStoragePoolGetXMLDesc",
124 sig => "pool, 0U : string" },
125 { name => "virStoragePoolGetUUID",
126 sig => "pool : uuid" },
127 { name => "virStoragePoolGetUUIDString",
128 sig => "pool : uuid string" },
129 { name => "virStoragePoolCreateXML",
130 sig => "conn, string, 0U : pool" },
131 { name => "virStoragePoolDefineXML",
132 sig => "conn, string, 0U : pool" },
133 { name => "virStoragePoolBuild",
134 sig => "pool, uint : unit" },
135 { name => "virStoragePoolUndefine",
136 sig => "pool : unit" },
137 { name => "virStoragePoolCreate",
138 sig => "pool, 0U : unit" },
139 { name => "virStoragePoolDelete",
140 sig => "pool, uint : unit" },
141 { name => "virStoragePoolRefresh",
142 sig => "pool, 0U : unit" },
143 { name => "virStoragePoolGetAutostart",
144 sig => "pool : bool" },
145 { name => "virStoragePoolSetAutostart",
146 sig => "pool, bool : unit" },
147 { name => "virStoragePoolNumOfVolumes",
148 sig => "pool : int" },
149 { name => "virStoragePoolListVolumes",
150 sig => "pool, int : string array" },
152 { name => "virStorageVolFree", sig => "vol : free" },
153 { name => "virStorageVolDelete",
154 sig => "vol, uint : unit" },
155 { name => "virStorageVolLookupByName",
156 sig => "pool, string : vol from pool" },
157 { name => "virStorageVolLookupByKey",
158 sig => "conn, string : vol" },
159 { name => "virStorageVolLookupByPath",
160 sig => "conn, string : vol" },
161 { name => "virStorageVolCreateXML",
162 sig => "pool, string, 0U : vol from pool" },
163 { name => "virStorageVolGetXMLDesc",
164 sig => "vol, 0U : string" },
165 { name => "virStorageVolGetPath",
166 sig => "vol : string" },
167 { name => "virStorageVolGetKey",
168 sig => "vol : static string" },
169 { name => "virStorageVolGetName",
170 sig => "vol : static string" },
171 { name => "virStoragePoolLookupByVolume",
172 sig => "vol : pool from vol" },
174 { name => "virSecretFree", sig => "sec : free" },
175 { name => "virSecretUndefine", sig => "sec : unit" },
176 { name => "virSecretLookupByUUID", sig => "conn, uuid : sec" },
177 { name => "virSecretLookupByUUIDString", sig => "conn, string : sec" },
178 { name => "virSecretDefineXML", sig => "conn, string, 0 : sec" },
179 { name => "virSecretGetUUID", sig => "sec : uuid" },
180 { name => "virSecretGetUUIDString", sig => "sec : uuid string" },
181 { name => "virSecretGetUsageType", sig => "sec : int" },
182 { name => "virSecretGetUsageID", sig => "sec : static string" },
183 { name => "virSecretGetXMLDesc", sig => "sec, 0 : string" },
187 # Functions we haven't implemented anywhere yet but which are mentioned
190 # We create stubs for these, but eventually they need to either be
191 # moved ^^^ so they are auto-generated, or implementations of them
192 # written in 'libvirt_c_oneoffs.c'.
194 my @unimplemented = (
197 #----------------------------------------------------------------------
199 # Open the output file.
201 my $filename = "libvirt_c.c";
202 open F, ">$filename" or die "$filename: $!";
204 # Write the prologue.
207 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
209 * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
211 * Any changes you make to this file may be overwritten.
214 /* OCaml bindings for libvirt.
215 * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
216 * https://libvirt.org/
218 * This library is free software; you can redistribute it and/or
219 * modify it under the terms of the GNU Lesser General Public
220 * License as published by the Free Software Foundation; either
221 * version 2 of the License, or (at your option) any later version,
222 * with the OCaml linking exception described in ../COPYING.LIB.
224 * This library is distributed in the hope that it will be useful,
225 * but WITHOUT ANY WARRANTY; without even the implied warranty of
226 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
227 * Lesser General Public License for more details.
229 * You should have received a copy of the GNU Lesser General Public
230 * License along with this library; if not, write to the Free Software
231 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
240 #include <libvirt/libvirt.h>
241 #include <libvirt/virterror.h>
243 #include <caml/config.h>
244 #include <caml/alloc.h>
245 #include <caml/callback.h>
246 #include <caml/custom.h>
247 #include <caml/fail.h>
248 #include <caml/memory.h>
249 #include <caml/misc.h>
250 #include <caml/mlvalues.h>
251 #include <caml/signals.h>
253 #include "libvirt_c_prologue.c"
255 #include "libvirt_c_oneoffs.c"
259 #----------------------------------------------------------------------
261 sub camel_case_to_underscores
265 $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
266 my @subs = split (/,/, $name);
267 @subs = map { lc($_) } @subs;
271 # Helper functions dealing with signatures.
273 sub short_name_to_c_type
277 if ($_ eq "conn") { "virConnectPtr" }
278 elsif ($_ eq "dom") { "virDomainPtr" }
279 elsif ($_ eq "net") { "virNetworkPtr" }
280 elsif ($_ eq "pool") { "virStoragePoolPtr" }
281 elsif ($_ eq "vol") { "virStorageVolPtr" }
282 elsif ($_ eq "sec") { "virSecretPtr" }
284 die "unknown short name $_"
288 # OCaml argument names.
294 if ($sig =~ /^(\w+) : string$/) {
296 } elsif ($sig =~ /^(\w+) : static string$/) {
298 } elsif ($sig =~ /^(\w+) : int$/) {
300 } elsif ($sig =~ /^(\w+) : uuid$/) {
302 } elsif ($sig =~ /^(\w+) : uuid string$/) {
304 } elsif ($sig =~ /^(\w+) : bool$/) {
306 } elsif ($sig =~ /^(\w+), bool : unit$/) {
308 } elsif ($sig eq "conn, int : int array") {
310 } elsif ($sig =~ /^(\w+), int : string array$/) {
312 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
314 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
316 } elsif ($sig =~ /^(\w+) : unit$/) {
318 } elsif ($sig =~ /^(\w+) : free$/) {
320 } elsif ($sig =~ /^(\w+), string : unit$/) {
322 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
324 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
326 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
328 } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
329 ( "$1v", "strv", "uv" )
330 } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
332 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
334 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
336 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
338 } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
340 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
342 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
344 } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
347 die "unknown signature $sig"
351 # Unpack the first (object) argument.
358 "virConnectPtr conn = Connect_val (connv);"
359 } elsif ($_ eq "dom") {
360 "virDomainPtr dom = Domain_val (domv);"
361 } elsif ($_ eq "net") {
362 "virNetworkPtr net = Network_val (netv);"
363 } elsif ($_ eq "pool") {
364 "virStoragePoolPtr pool = Pool_val (poolv);"
365 } elsif ($_ eq "vol") {
366 "virStorageVolPtr vol = Volume_val (volv);"
367 } elsif ($_ eq "sec") {
368 "virSecretPtr sec = Secret_val (secv);"
370 die "unknown short name $_"
374 # Pack the result if it's an object.
380 if ($_ eq "dom") { "rv = Val_domain (r, connv);" }
381 elsif ($_ eq "net") { "rv = Val_network (r, connv);" }
382 elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
383 elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" }
384 elsif ($_ eq "sec") { "rv = Val_secret (r, connv);" }
386 die "unknown short name $_"
394 if ($_ eq "conn") { "Connect_val (connv) = NULL;" }
395 elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" }
396 elsif ($_ eq "net") { "Network_val (netv) = NULL;" }
397 elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" }
398 elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" }
399 elsif ($_ eq "sec") { "Secret_val (secv) = NULL;" }
401 die "unknown short name $_"
405 # Generate the C body for each signature (class of function).
412 if ($sig =~ /^(\w+) : string$/) {
415 " . gen_unpack_args ($1) . "
418 NONBLOCKING (r = $c_name ($1));
419 CHECK_ERROR (!r, \"$c_name\");
421 rv = caml_copy_string (r);
425 } elsif ($sig =~ /^(\w+) : static string$/) {
428 " . gen_unpack_args ($1) . "
431 NONBLOCKING (r = $c_name ($1));
432 CHECK_ERROR (!r, \"$c_name\");
434 rv = caml_copy_string (r);
437 } elsif ($sig =~ /^(\w+) : int$/) {
439 " . gen_unpack_args ($1) . "
442 NONBLOCKING (r = $c_name ($1));
443 CHECK_ERROR (r == -1, \"$c_name\");
445 CAMLreturn (Val_int (r));
447 } elsif ($sig =~ /^(\w+) : uuid$/) {
450 " . gen_unpack_args ($1) . "
451 unsigned char uuid[VIR_UUID_BUFLEN];
454 NONBLOCKING (r = $c_name ($1, uuid));
455 CHECK_ERROR (r == -1, \"$c_name\");
457 /* UUIDs are byte arrays with a fixed length. */
458 rv = caml_alloc_string (VIR_UUID_BUFLEN);
459 memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
462 } elsif ($sig =~ /^(\w+) : uuid string$/) {
465 " . gen_unpack_args ($1) . "
466 char uuid[VIR_UUID_STRING_BUFLEN];
469 NONBLOCKING (r = $c_name ($1, uuid));
470 CHECK_ERROR (r == -1, \"$c_name\");
472 rv = caml_copy_string (uuid);
475 } elsif ($sig =~ /^(\w+) : bool$/) {
477 " . gen_unpack_args ($1) . "
480 NONBLOCKING (r = $c_name ($1, &b));
481 CHECK_ERROR (r == -1, \"$c_name\");
483 CAMLreturn (b ? Val_true : Val_false);
485 } elsif ($sig =~ /^(\w+), bool : unit$/) {
487 " . gen_unpack_args ($1) . "
490 b = bv == Val_true ? 1 : 0;
492 NONBLOCKING (r = $c_name ($1, b));
493 CHECK_ERROR (r == -1, \"$c_name\");
495 CAMLreturn (Val_unit);
497 } elsif ($sig eq "conn, int : int array") {
500 virConnectPtr conn = Connect_val (connv);
501 int i = Int_val (iv);
504 /* Some libvirt List* functions still throw exceptions if i == 0,
505 * so catch that and return an empty array directly. This changes
506 * the semantics slightly (masking other failures) but it's
507 * unlikely anyone will care. RWMJ 2008/06/10
510 rv = caml_alloc (0, 0);
514 ids = malloc (sizeof (*ids) * i);
516 caml_raise_out_of_memory ();
518 NONBLOCKING (r = $c_name (conn, ids, i));
519 CHECK_ERROR_CLEANUP (r == -1, free (ids), \"$c_name\");
521 rv = caml_alloc (r, 0);
522 for (i = 0; i < r; ++i)
523 Store_field (rv, i, Val_int (ids[i]));
528 } elsif ($sig =~ /^(\w+), int : string array$/) {
530 CAMLlocal2 (rv, strv);
531 " . gen_unpack_args ($1) . "
532 int i = Int_val (iv);
536 /* Some libvirt List* functions still throw exceptions if i == 0,
537 * so catch that and return an empty array directly. This changes
538 * the semantics slightly (masking other failures) but it's
539 * unlikely anyone will care. RWMJ 2008/06/10
542 rv = caml_alloc (0, 0);
546 names = malloc (sizeof (*names) * i);
548 caml_raise_out_of_memory ();
550 NONBLOCKING (r = $c_name ($1, names, i));
551 CHECK_ERROR_CLEANUP (r == -1, free (names), \"$c_name\");
553 rv = caml_alloc (r, 0);
554 for (i = 0; i < r; ++i) {
555 strv = caml_copy_string (names[i]);
556 Store_field (rv, i, strv);
563 } elsif ($sig =~ /^(\w+), 0U? : string$/) {
566 " . gen_unpack_args ($1) . "
569 NONBLOCKING (r = $c_name ($1, 0));
570 CHECK_ERROR (!r, \"$c_name\");
572 rv = caml_copy_string (r);
576 } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
578 " . gen_unpack_args ($1) . "
581 NONBLOCKING (r = $c_name ($1, 0));
582 CHECK_ERROR (r == -1, \"$c_name\");
584 CAMLreturn (Val_unit);
586 } elsif ($sig =~ /^(\w+) : unit$/) {
588 " . gen_unpack_args ($1) . "
591 NONBLOCKING (r = $c_name ($1));
592 CHECK_ERROR (r == -1, \"$c_name\");
594 CAMLreturn (Val_unit);
596 } elsif ($sig =~ /^(\w+) : free$/) {
598 " . gen_unpack_args ($1) . "
601 NONBLOCKING (r = $c_name ($1));
602 CHECK_ERROR (r == -1, \"$c_name\");
604 /* So that we don't double-free in the finalizer: */
605 " . gen_free_arg ($1) . "
607 CAMLreturn (Val_unit);
609 } elsif ($sig =~ /^(\w+), string : unit$/) {
611 " . gen_unpack_args ($1) . "
612 char *str = String_val (strv);
615 NONBLOCKING (r = $c_name ($1, str));
616 CHECK_ERROR (r == -1, \"$c_name\");
618 CAMLreturn (Val_unit);
620 } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
623 " . gen_unpack_args ($1) . "
624 char *str = String_val (strv);
627 NONBLOCKING (r = $c_name ($1, str, 0));
628 CHECK_ERROR (!r, \"$c_name\");
630 CAMLreturn (Val_unit);
632 } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
633 my $c_ret_type = short_name_to_c_type ($2);
636 " . gen_unpack_args ($1) . "
637 char *str = String_val (strv);
640 NONBLOCKING (r = $c_name ($1, str));
641 CHECK_ERROR (!r, \"$c_name\");
643 " . gen_pack_result ($2) . "
647 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
648 my $c_ret_type = short_name_to_c_type ($2);
651 " . gen_unpack_args ($1) . "
652 char *str = String_val (strv);
655 NONBLOCKING (r = $c_name ($1, str, 0));
656 CHECK_ERROR (!r, \"$c_name\");
658 " . gen_pack_result ($2) . "
662 } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
663 my $c_ret_type = short_name_to_c_type ($2);
666 " . gen_unpack_args ($1) . "
667 char *str = String_val (strv);
668 unsigned int u = Int_val (uv);
671 NONBLOCKING (r = $c_name ($1, str, u));
672 CHECK_ERROR (!r, \"$c_name\");
674 " . gen_pack_result ($2) . "
678 } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
679 my $unsigned = $2 eq "u" ? "unsigned " : "";
681 " . gen_unpack_args ($1) . "
682 ${unsigned}int i = Int_val (iv);
685 NONBLOCKING (r = $c_name ($1, i));
686 CHECK_ERROR (r == -1, \"$c_name\");
688 CAMLreturn (Val_unit);
690 } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
691 my $c_ret_type = short_name_to_c_type ($3);
692 my $unsigned = $2 eq "u" ? "unsigned " : "";
695 " . gen_unpack_args ($1) . "
696 ${unsigned}int i = Int_val (iv);
699 NONBLOCKING (r = $c_name ($1, i));
700 CHECK_ERROR (!r, \"$c_name\");
702 " . gen_pack_result ($3) . "
706 } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
707 my $c_ret_type = short_name_to_c_type ($2);
710 " . gen_unpack_args ($1) . "
711 unsigned char *uuid = (unsigned char *) String_val (uuidv);
714 NONBLOCKING (r = $c_name ($1, uuid));
715 CHECK_ERROR (!r, \"$c_name\");
717 " . gen_pack_result ($2) . "
721 } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
722 my $c_ret_type = short_name_to_c_type ($2);
725 " . gen_unpack_args ($1) . "
728 NONBLOCKING (r = $c_name ($1, 0));
729 CHECK_ERROR (!r, \"$c_name\");
731 " . gen_pack_result ($2) . "
735 } elsif ($sig =~ /^(\w+) : (\w+)$/) {
736 my $c_ret_type = short_name_to_c_type ($2);
739 " . gen_unpack_args ($1) . "
742 NONBLOCKING (r = $c_name ($1));
743 CHECK_ERROR (!r, \"$c_name\");
745 " . gen_pack_result ($2) . "
749 } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
750 my $c_ret_type = short_name_to_c_type ($2);
752 CAMLlocal2 (rv, connv);
753 " . gen_unpack_args ($1) . "
754 char *str = String_val (strv);
757 NONBLOCKING (r = $c_name ($1, str));
758 CHECK_ERROR (!r, \"$c_name\");
760 connv = Field ($3v, 1);
761 " . gen_pack_result ($2) . "
765 } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
766 my $c_ret_type = short_name_to_c_type ($2);
768 CAMLlocal2 (rv, connv);
769 " . gen_unpack_args ($1) . "
770 char *str = String_val (strv);
773 NONBLOCKING (r = $c_name ($1, str, 0));
774 CHECK_ERROR (!r, \"$c_name\");
776 connv = Field ($3v, 1);
777 " . gen_pack_result ($2) . "
781 } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
782 my $c_ret_type = short_name_to_c_type ($2);
784 CAMLlocal2 (rv, connv);
785 " . gen_unpack_args ($1) . "
788 NONBLOCKING (r = $c_name ($1, 0));
789 CHECK_ERROR (!r, \"$c_name\");
791 connv = Field ($3v, 1);
792 " . gen_pack_result ($2) . "
796 } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
797 my $c_ret_type = short_name_to_c_type ($2);
799 CAMLlocal2 (rv, connv);
800 " . gen_unpack_args ($1) . "
803 NONBLOCKING (r = $c_name ($1));
804 CHECK_ERROR (!r, \"$c_name\");
806 connv = Field ($3v, 1);
807 " . gen_pack_result ($2) . "
812 die "unknown signature $sig"
816 # Generate each function.
818 foreach my $function (@functions) {
819 my $c_name = $function->{name};
820 my $sig = $function->{sig};
822 #print "generating $c_name with sig \"$sig\" ...\n";
824 #my $is_pool_func = $c_name =~ /^virStoragePool/;
825 #my $is_vol_func = $c_name =~ /^virStorageVol/;
827 # Generate an equivalent C-external name for the function, unless
828 # one is defined already.
830 if (exists ($function->{c_external_name})) {
831 $c_external_name = $function->{c_external_name};
832 } elsif ($c_name =~ /^vir/) {
833 $c_external_name = substr $c_name, 3;
834 $c_external_name = camel_case_to_underscores ($c_external_name);
835 $c_external_name = "ocaml_libvirt_" . $c_external_name;
837 die "cannot convert c_name $c_name to c_external_name"
841 /* Automatically generated binding for $c_name.
842 * In generator.pl this function has signature "$sig".
847 my @arg_names = gen_arg_names ($sig);
848 my $nr_arg_names = scalar @arg_names;
849 my $arg_names = join ", ", @arg_names;
850 my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
852 # Generate the start of the function, arguments.
855 $c_external_name ($arg_names_as_values)
857 CAMLparam$nr_arg_names ($arg_names);
860 # Generate the internals of the function.
861 print F (gen_c_code ($sig, $c_name));
863 # Finish off the function.
870 #----------------------------------------------------------------------
872 # Unimplemented functions.
874 if (@unimplemented) {
875 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
878 /* The following functions are unimplemented and always fail.
879 * See generator.pl '@unimplemented'
884 foreach my $c_external_name (@unimplemented) {
889 failwith ("$c_external_name is unimplemented");
894 } # end if @unimplemented
896 #----------------------------------------------------------------------
898 # Write the epilogue.
901 #include "libvirt_c_epilogue.c"
907 print "$0: written $filename\n"