libvirt/generator.pl

   1 #!/usr/bin/perl -w
   2 #
   3 # OCaml bindings for libvirt.
   4 # (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
   5 # https://libvirt.org/
   6 #
   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.
  12 #
  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.
  17 #
  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
  21
  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).
  25 #
  26 # Please read libvirt/README.
  27
  28 use strict;
  29
  30 #----------------------------------------------------------------------
  31
  32 # The functions in the libvirt API that we can generate.
  33
  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
  37 # binding.
  38
  39 my @functions = (
  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" },
  66
  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" },
  95
  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" },
 112
 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" },
 151
 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" },
 173
 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" },
 184
 185     );
 186
 187 # Functions we haven't implemented anywhere yet but which are mentioned
 188 # in 'libvirt.ml'.
 189 #
 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'.
 193
 194 my @unimplemented = (
 195     );
 196
 197 #----------------------------------------------------------------------
 198
 199 # Open the output file.
 200
 201 my $filename = "libvirt_c.c";
 202 open F, ">$filename" or die "$filename: $!";
 203
 204 # Write the prologue.
 205
 206 print F <<'END';
 207 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
 208  *
 209  * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
 210  *
 211  * Any changes you make to this file may be overwritten.
 212  */
 213
 214 /* OCaml bindings for libvirt.
 215  * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
 216  * https://libvirt.org/
 217  *
 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.
 223  *
 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.
 228  *
 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
 232  */
 233
 234 #include "config.h"
 235
 236 #include <stdio.h>
 237 #include <stdlib.h>
 238 #include <string.h>
 239
 240 #include <libvirt/libvirt.h>
 241 #include <libvirt/virterror.h>
 242
 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>
 252
 253 #include "libvirt_c_prologue.c"
 254
 255 #include "libvirt_c_oneoffs.c"
 256
 257 END
 258
 259 #----------------------------------------------------------------------
 260
 261 sub camel_case_to_underscores
 262 {
 263     my $name = shift;
 264
 265     $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
 266     my @subs = split (/,/, $name);
 267     @subs = map { lc($_) } @subs;
 268     join "_", @subs
 269 }
 270
 271 # Helper functions dealing with signatures.
 272
 273 sub short_name_to_c_type
 274 {
 275     local $_ = shift;
 276
 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" }
 283     else {
 284         die "unknown short name $_"
 285     }
 286 }
 287
 288 # OCaml argument names.
 289
 290 sub gen_arg_names
 291 {
 292     my $sig = shift;
 293
 294     if ($sig =~ /^(\w+) : string$/) {
 295         ( "$1v" )
 296     } elsif ($sig =~ /^(\w+) : static string$/) {
 297         ( "$1v" )
 298     } elsif ($sig =~ /^(\w+) : int$/) {
 299         ( "$1v" )
 300     } elsif ($sig =~ /^(\w+) : uuid$/) {
 301         ( "$1v" )
 302     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 303         ( "$1v" )
 304     } elsif ($sig =~ /^(\w+) : bool$/) {
 305         ( "$1v" )
 306     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 307         ( "$1v", "bv" )
 308     } elsif ($sig eq "conn, int : int array") {
 309         ( "connv", "iv" )
 310     } elsif ($sig =~ /^(\w+), int : string array$/) {
 311         ( "$1v", "iv" )
 312     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 313         ( "$1v" )
 314     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 315         ( "$1v" )
 316     } elsif ($sig =~ /^(\w+) : unit$/) {
 317         ( "$1v" )
 318     } elsif ($sig =~ /^(\w+) : free$/) {
 319         ( "$1v" )
 320     } elsif ($sig =~ /^(\w+), string : unit$/) {
 321         ( "$1v", "strv" )
 322     } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
 323         ( "$1v", "strv" )
 324     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 325         ( "$1v", "strv" )
 326     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
 327         ( "$1v", "strv" )
 328     } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
 329         ( "$1v", "strv", "uv" )
 330     } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
 331         ( "$1v", "iv" )
 332     } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
 333         ( "$1v", "uuidv" )
 334     } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
 335         ( "$1v" )
 336     } elsif ($sig =~ /^(\w+) : (\w+)$/) {
 337         ( "$1v" )
 338     } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
 339         ( "$1v", "strv" )
 340     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
 341         ( "$1v", "strv" )
 342     } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
 343         ( "$1v" )
 344     } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
 345         ( "$1v" )
 346     } else {
 347         die "unknown signature $sig"
 348     }
 349 }
 350
 351 # Unpack the first (object) argument.
 352
 353 sub gen_unpack_args
 354 {
 355     local $_ = shift;
 356
 357     if ($_ eq "conn") {
 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);"
 369     } else {
 370         die "unknown short name $_"
 371     }
 372 }
 373
 374 # Pack the result if it's an object.
 375
 376 sub gen_pack_result
 377 {
 378     local $_ = shift;
 379
 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);" }
 385     else {
 386         die "unknown short name $_"
 387     }
 388 }
 389
 390 sub gen_free_arg
 391 {
 392     local $_ = shift;
 393
 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;" }
 400     else {
 401         die "unknown short name $_"
 402     }
 403 }
 404
 405 # Generate the C body for each signature (class of function).
 406
 407 sub gen_c_code
 408 {
 409     my $sig = shift;
 410     my $c_name = shift;
 411
 412     if ($sig =~ /^(\w+) : string$/) {
 413         "\
 414   CAMLlocal1 (rv);
 415   " . gen_unpack_args ($1) . "
 416   char *r;
 417
 418   NONBLOCKING (r = $c_name ($1));
 419   CHECK_ERROR (!r, \"$c_name\");
 420
 421   rv = caml_copy_string (r);
 422   free (r);
 423   CAMLreturn (rv);
 424 "
 425     } elsif ($sig =~ /^(\w+) : static string$/) {
 426         "\
 427   CAMLlocal1 (rv);
 428   " . gen_unpack_args ($1) . "
 429   const char *r;
 430
 431   NONBLOCKING (r = $c_name ($1));
 432   CHECK_ERROR (!r, \"$c_name\");
 433
 434   rv = caml_copy_string (r);
 435   CAMLreturn (rv);
 436 "
 437     } elsif ($sig =~ /^(\w+) : int$/) {
 438         "\
 439   " . gen_unpack_args ($1) . "
 440   int r;
 441
 442   NONBLOCKING (r = $c_name ($1));
 443   CHECK_ERROR (r == -1, \"$c_name\");
 444
 445   CAMLreturn (Val_int (r));
 446 "
 447     } elsif ($sig =~ /^(\w+) : uuid$/) {
 448         "\
 449   CAMLlocal1 (rv);
 450   " . gen_unpack_args ($1) . "
 451   unsigned char uuid[VIR_UUID_BUFLEN];
 452   int r;
 453
 454   NONBLOCKING (r = $c_name ($1, uuid));
 455   CHECK_ERROR (r == -1, \"$c_name\");
 456
 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);
 460   CAMLreturn (rv);
 461 "
 462     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 463         "\
 464   CAMLlocal1 (rv);
 465   " . gen_unpack_args ($1) . "
 466   char uuid[VIR_UUID_STRING_BUFLEN];
 467   int r;
 468
 469   NONBLOCKING (r = $c_name ($1, uuid));
 470   CHECK_ERROR (r == -1, \"$c_name\");
 471
 472   rv = caml_copy_string (uuid);
 473   CAMLreturn (rv);
 474 "
 475     } elsif ($sig =~ /^(\w+) : bool$/) {
 476         "\
 477   " . gen_unpack_args ($1) . "
 478   int r, b;
 479
 480   NONBLOCKING (r = $c_name ($1, &b));
 481   CHECK_ERROR (r == -1, \"$c_name\");
 482
 483   CAMLreturn (b ? Val_true : Val_false);
 484 "
 485     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 486         "\
 487   " . gen_unpack_args ($1) . "
 488   int r, b;
 489
 490   b = bv == Val_true ? 1 : 0;
 491
 492   NONBLOCKING (r = $c_name ($1, b));
 493   CHECK_ERROR (r == -1, \"$c_name\");
 494
 495   CAMLreturn (Val_unit);
 496 "
 497     } elsif ($sig eq "conn, int : int array") {
 498         "\
 499   CAMLlocal1 (rv);
 500   virConnectPtr conn = Connect_val (connv);
 501   int i = Int_val (iv);
 502   int *ids, r;
 503
 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
 508    */
 509   if (i == 0) {
 510     rv = caml_alloc (0, 0);
 511     CAMLreturn (rv);
 512   }
 513
 514   ids = malloc (sizeof (*ids) * i);
 515   if (ids == NULL)
 516     caml_raise_out_of_memory ();
 517
 518   NONBLOCKING (r = $c_name (conn, ids, i));
 519   CHECK_ERROR_CLEANUP (r == -1, free (ids), \"$c_name\");
 520
 521   rv = caml_alloc (r, 0);
 522   for (i = 0; i < r; ++i)
 523     Store_field (rv, i, Val_int (ids[i]));
 524   free (ids);
 525
 526   CAMLreturn (rv);
 527 "
 528     } elsif ($sig =~ /^(\w+), int : string array$/) {
 529         "\
 530   CAMLlocal2 (rv, strv);
 531   " . gen_unpack_args ($1) . "
 532   int i = Int_val (iv);
 533   char **names;
 534   int r;
 535
 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
 540    */
 541   if (i == 0) {
 542     rv = caml_alloc (0, 0);
 543     CAMLreturn (rv);
 544   }
 545
 546   names = malloc (sizeof (*names) * i);
 547   if (names == NULL)
 548     caml_raise_out_of_memory ();
 549
 550   NONBLOCKING (r = $c_name ($1, names, i));
 551   CHECK_ERROR_CLEANUP (r == -1, free (names), \"$c_name\");
 552
 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);
 557     free (names[i]);
 558   }
 559   free (names);
 560
 561   CAMLreturn (rv);
 562 "
 563     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 564         "\
 565   CAMLlocal1 (rv);
 566   " . gen_unpack_args ($1) . "
 567   char *r;
 568
 569   NONBLOCKING (r = $c_name ($1, 0));
 570   CHECK_ERROR (!r, \"$c_name\");
 571
 572   rv = caml_copy_string (r);
 573   free (r);
 574   CAMLreturn (rv);
 575 "
 576     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 577         "\
 578   " . gen_unpack_args ($1) . "
 579   int r;
 580
 581   NONBLOCKING (r = $c_name ($1, 0));
 582   CHECK_ERROR (r == -1, \"$c_name\");
 583
 584   CAMLreturn (Val_unit);
 585 "
 586     } elsif ($sig =~ /^(\w+) : unit$/) {
 587         "\
 588   " . gen_unpack_args ($1) . "
 589   int r;
 590
 591   NONBLOCKING (r = $c_name ($1));
 592   CHECK_ERROR (r == -1, \"$c_name\");
 593
 594   CAMLreturn (Val_unit);
 595 "
 596     } elsif ($sig =~ /^(\w+) : free$/) {
 597         "\
 598   " . gen_unpack_args ($1) . "
 599   int r;
 600
 601   NONBLOCKING (r = $c_name ($1));
 602   CHECK_ERROR (r == -1, \"$c_name\");
 603
 604   /* So that we don't double-free in the finalizer: */
 605   " . gen_free_arg ($1) . "
 606
 607   CAMLreturn (Val_unit);
 608 "
 609     } elsif ($sig =~ /^(\w+), string : unit$/) {
 610         "\
 611   " . gen_unpack_args ($1) . "
 612   char *str = String_val (strv);
 613   int r;
 614
 615   NONBLOCKING (r = $c_name ($1, str));
 616   CHECK_ERROR (r == -1, \"$c_name\");
 617
 618   CAMLreturn (Val_unit);
 619 "
 620     } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
 621         "\
 622   CAMLlocal1 (rv);
 623   " . gen_unpack_args ($1) . "
 624   char *str = String_val (strv);
 625   int r;
 626
 627   NONBLOCKING (r = $c_name ($1, str, 0));
 628   CHECK_ERROR (!r, \"$c_name\");
 629
 630   CAMLreturn (Val_unit);
 631 "
 632     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 633         my $c_ret_type = short_name_to_c_type ($2);
 634         "\
 635   CAMLlocal1 (rv);
 636   " . gen_unpack_args ($1) . "
 637   char *str = String_val (strv);
 638   $c_ret_type r;
 639
 640   NONBLOCKING (r = $c_name ($1, str));
 641   CHECK_ERROR (!r, \"$c_name\");
 642
 643   " . gen_pack_result ($2) . "
 644
 645   CAMLreturn (rv);
 646 "
 647     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
 648         my $c_ret_type = short_name_to_c_type ($2);
 649         "\
 650   CAMLlocal1 (rv);
 651   " . gen_unpack_args ($1) . "
 652   char *str = String_val (strv);
 653   $c_ret_type r;
 654
 655   NONBLOCKING (r = $c_name ($1, str, 0));
 656   CHECK_ERROR (!r, \"$c_name\");
 657
 658   " . gen_pack_result ($2) . "
 659
 660   CAMLreturn (rv);
 661 "
 662     } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
 663         my $c_ret_type = short_name_to_c_type ($2);
 664         "\
 665   CAMLlocal1 (rv);
 666   " . gen_unpack_args ($1) . "
 667   char *str = String_val (strv);
 668   unsigned int u = Int_val (uv);
 669   $c_ret_type r;
 670
 671   NONBLOCKING (r = $c_name ($1, str, u));
 672   CHECK_ERROR (!r, \"$c_name\");
 673
 674   " . gen_pack_result ($2) . "
 675
 676   CAMLreturn (rv);
 677 "
 678     } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
 679         my $unsigned = $2 eq "u" ? "unsigned " : "";
 680         "\
 681   " . gen_unpack_args ($1) . "
 682   ${unsigned}int i = Int_val (iv);
 683   int r;
 684
 685   NONBLOCKING (r = $c_name ($1, i));
 686   CHECK_ERROR (r == -1, \"$c_name\");
 687
 688   CAMLreturn (Val_unit);
 689 "
 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 " : "";
 693         "\
 694   CAMLlocal1 (rv);
 695   " . gen_unpack_args ($1) . "
 696   ${unsigned}int i = Int_val (iv);
 697   $c_ret_type r;
 698
 699   NONBLOCKING (r = $c_name ($1, i));
 700   CHECK_ERROR (!r, \"$c_name\");
 701
 702   " . gen_pack_result ($3) . "
 703
 704   CAMLreturn (rv);
 705 "
 706     } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
 707         my $c_ret_type = short_name_to_c_type ($2);
 708         "\
 709   CAMLlocal1 (rv);
 710   " . gen_unpack_args ($1) . "
 711   unsigned char *uuid = (unsigned char *) String_val (uuidv);
 712   $c_ret_type r;
 713
 714   NONBLOCKING (r = $c_name ($1, uuid));
 715   CHECK_ERROR (!r, \"$c_name\");
 716
 717   " . gen_pack_result ($2) . "
 718
 719   CAMLreturn (rv);
 720 "
 721     } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
 722         my $c_ret_type = short_name_to_c_type ($2);
 723         "\
 724   CAMLlocal1 (rv);
 725   " . gen_unpack_args ($1) . "
 726   $c_ret_type r;
 727
 728   NONBLOCKING (r = $c_name ($1, 0));
 729   CHECK_ERROR (!r, \"$c_name\");
 730
 731   " . gen_pack_result ($2) . "
 732
 733   CAMLreturn (rv);
 734 "
 735     } elsif ($sig =~ /^(\w+) : (\w+)$/) {
 736         my $c_ret_type = short_name_to_c_type ($2);
 737         "\
 738   CAMLlocal1 (rv);
 739   " . gen_unpack_args ($1) . "
 740   $c_ret_type r;
 741
 742   NONBLOCKING (r = $c_name ($1));
 743   CHECK_ERROR (!r, \"$c_name\");
 744
 745   " . gen_pack_result ($2) . "
 746
 747   CAMLreturn (rv);
 748 "
 749     } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
 750         my $c_ret_type = short_name_to_c_type ($2);
 751         "\
 752   CAMLlocal2 (rv, connv);
 753   " . gen_unpack_args ($1) . "
 754   char *str = String_val (strv);
 755   $c_ret_type r;
 756
 757   NONBLOCKING (r = $c_name ($1, str));
 758   CHECK_ERROR (!r, \"$c_name\");
 759
 760   connv = Field ($3v, 1);
 761   " . gen_pack_result ($2) . "
 762
 763   CAMLreturn (rv);
 764 "
 765     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
 766         my $c_ret_type = short_name_to_c_type ($2);
 767         "\
 768   CAMLlocal2 (rv, connv);
 769   " . gen_unpack_args ($1) . "
 770   char *str = String_val (strv);
 771   $c_ret_type r;
 772
 773   NONBLOCKING (r = $c_name ($1, str, 0));
 774   CHECK_ERROR (!r, \"$c_name\");
 775
 776   connv = Field ($3v, 1);
 777   " . gen_pack_result ($2) . "
 778
 779   CAMLreturn (rv);
 780 "
 781     } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
 782         my $c_ret_type = short_name_to_c_type ($2);
 783         "\
 784   CAMLlocal2 (rv, connv);
 785   " . gen_unpack_args ($1) . "
 786   $c_ret_type r;
 787
 788   NONBLOCKING (r = $c_name ($1, 0));
 789   CHECK_ERROR (!r, \"$c_name\");
 790
 791   connv = Field ($3v, 1);
 792   " . gen_pack_result ($2) . "
 793
 794   CAMLreturn (rv);
 795 "
 796     } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
 797         my $c_ret_type = short_name_to_c_type ($2);
 798         "\
 799   CAMLlocal2 (rv, connv);
 800   " . gen_unpack_args ($1) . "
 801   $c_ret_type r;
 802
 803   NONBLOCKING (r = $c_name ($1));
 804   CHECK_ERROR (!r, \"$c_name\");
 805
 806   connv = Field ($3v, 1);
 807   " . gen_pack_result ($2) . "
 808
 809   CAMLreturn (rv);
 810 "
 811     } else {
 812         die "unknown signature $sig"
 813     }
 814 }
 815
 816 # Generate each function.
 817
 818 foreach my $function (@functions) {
 819     my $c_name = $function->{name};
 820     my $sig = $function->{sig};
 821
 822     #print "generating $c_name with sig \"$sig\" ...\n";
 823
 824     #my $is_pool_func = $c_name =~ /^virStoragePool/;
 825     #my $is_vol_func = $c_name =~ /^virStorageVol/;
 826
 827     # Generate an equivalent C-external name for the function, unless
 828     # one is defined already.
 829     my $c_external_name;
 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;
 836     } else {
 837         die "cannot convert c_name $c_name to c_external_name"
 838     }
 839
 840     print F <<END;
 841 /* Automatically generated binding for $c_name.
 842  * In generator.pl this function has signature "$sig".
 843  */
 844
 845 END
 846
 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);
 851
 852     # Generate the start of the function, arguments.
 853     print F <<END;
 854 CAMLprim value
 855 $c_external_name ($arg_names_as_values)
 856 {
 857   CAMLparam$nr_arg_names ($arg_names);
 858 END
 859
 860     # Generate the internals of the function.
 861     print F (gen_c_code ($sig, $c_name));
 862
 863     # Finish off the function.
 864     print F <<END;
 865 }
 866
 867 END
 868 }
 869
 870 #----------------------------------------------------------------------
 871
 872 # Unimplemented functions.
 873
 874 if (@unimplemented) {
 875     printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
 876
 877     print F <<'END';
 878 /* The following functions are unimplemented and always fail.
 879  * See generator.pl '@unimplemented'
 880  */
 881
 882 END
 883
 884     foreach my $c_external_name (@unimplemented) {
 885         print F <<END;
 886 CAMLprim value
 887 $c_external_name ()
 888 {
 889   failwith ("$c_external_name is unimplemented");
 890 }
 891
 892 END
 893     } # end foreach
 894 } # end if @unimplemented
 895
 896 #----------------------------------------------------------------------
 897
 898 # Write the epilogue.
 899
 900 print F <<'END';
 901 #include "libvirt_c_epilogue.c"
 902
 903 /* EOF */
 904 END
 905
 906 close F;
 907 print "$0: written $filename\n"
 908