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 # http://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 => "virConnectGetCapabilities", sig => "conn : string" },
  62     { name => "virConnectDomainEventDeregisterAny",
  63       sig => "conn, int : unit" },
  64
  65     { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" },
  66     { name => "virDomainCreateXML", sig => "conn, string, unsigned : dom" },
  67     { name => "virDomainFree", sig => "dom : free" },
  68     { name => "virDomainDestroy", sig => "dom : free" },
  69     { name => "virDomainLookupByName", sig => "conn, string : dom" },
  70     { name => "virDomainLookupByID", sig => "conn, int : dom" },
  71     { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" },
  72     { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
  73     { name => "virDomainGetName", sig => "dom : static string" },
  74     { name => "virDomainGetOSType", sig => "dom : string" },
  75     { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
  76     { name => "virDomainGetUUID", sig => "dom : uuid" },
  77     { name => "virDomainGetUUIDString", sig => "dom : uuid string" },
  78     { name => "virDomainGetMaxVcpus", sig => "dom : int" },
  79     { name => "virDomainSave", sig => "dom, string : unit" },
  80     { name => "virDomainRestore", sig => "conn, string : unit" },
  81     { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" },
  82     { name => "virDomainSuspend", sig => "dom : unit" },
  83     { name => "virDomainResume", sig => "dom : unit" },
  84     { name => "virDomainShutdown", sig => "dom : unit" },
  85     { name => "virDomainReboot", sig => "dom, 0 : unit" },
  86     { name => "virDomainDefineXML", sig => "conn, string : dom" },
  87     { name => "virDomainUndefine", sig => "dom : unit" },
  88     { name => "virDomainCreate", sig => "dom : unit" },
  89     { name => "virDomainAttachDevice", sig => "dom, string : unit" },
  90     { name => "virDomainDetachDevice", sig => "dom, string : unit" },
  91     { name => "virDomainGetAutostart", sig => "dom : bool" },
  92     { name => "virDomainSetAutostart", sig => "dom, bool : unit" },
  93
  94     { name => "virNetworkFree", sig => "net : free" },
  95     { name => "virNetworkDestroy", sig => "net : free" },
  96     { name => "virNetworkLookupByName", sig => "conn, string : net" },
  97     { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" },
  98     { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
  99     { name => "virNetworkGetName", sig => "net : static string" },
 100     { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
 101     { name => "virNetworkGetBridgeName", sig => "net : string" },
 102     { name => "virNetworkGetUUID", sig => "net : uuid" },
 103     { name => "virNetworkGetUUIDString", sig => "net : uuid string" },
 104     { name => "virNetworkUndefine", sig => "net : unit" },
 105     { name => "virNetworkCreateXML", sig => "conn, string : net" },
 106     { name => "virNetworkDefineXML", sig => "conn, string : net" },
 107     { name => "virNetworkCreate", sig => "net : unit" },
 108     { name => "virNetworkGetAutostart", sig => "net : bool" },
 109     { name => "virNetworkSetAutostart", sig => "net, bool : unit" },
 110
 111     { name => "virStoragePoolFree", sig => "pool : free" },
 112     { name => "virStoragePoolDestroy", sig => "pool : free" },
 113     { name => "virStoragePoolLookupByName",
 114       sig => "conn, string : pool" },
 115     { name => "virStoragePoolLookupByUUID",
 116       sig => "conn, uuid : pool" },
 117     { name => "virStoragePoolLookupByUUIDString",
 118       sig => "conn, string : pool" },
 119     { name => "virStoragePoolGetName",
 120       sig => "pool : static string" },
 121     { name => "virStoragePoolGetXMLDesc",
 122       sig => "pool, 0U : string" },
 123     { name => "virStoragePoolGetUUID",
 124       sig => "pool : uuid" },
 125     { name => "virStoragePoolGetUUIDString",
 126       sig => "pool : uuid string" },
 127     { name => "virStoragePoolCreateXML",
 128       sig => "conn, string, 0U : pool" },
 129     { name => "virStoragePoolDefineXML",
 130       sig => "conn, string, 0U : pool" },
 131     { name => "virStoragePoolBuild",
 132       sig => "pool, uint : unit" },
 133     { name => "virStoragePoolUndefine",
 134       sig => "pool : unit" },
 135     { name => "virStoragePoolCreate",
 136       sig => "pool, 0U : unit" },
 137     { name => "virStoragePoolDelete",
 138       sig => "pool, uint : unit" },
 139     { name => "virStoragePoolRefresh",
 140       sig => "pool, 0U : unit" },
 141     { name => "virStoragePoolGetAutostart",
 142       sig => "pool : bool" },
 143     { name => "virStoragePoolSetAutostart",
 144       sig => "pool, bool : unit" },
 145     { name => "virStoragePoolNumOfVolumes",
 146       sig => "pool : int" },
 147     { name => "virStoragePoolListVolumes",
 148       sig => "pool, int : string array" },
 149
 150     { name => "virStorageVolFree", sig => "vol : free" },
 151     { name => "virStorageVolDelete",
 152       sig => "vol, uint : unit" },
 153     { name => "virStorageVolLookupByName",
 154       sig => "pool, string : vol from pool" },
 155     { name => "virStorageVolLookupByKey",
 156       sig => "conn, string : vol" },
 157     { name => "virStorageVolLookupByPath",
 158       sig => "conn, string : vol" },
 159     { name => "virStorageVolCreateXML",
 160       sig => "pool, string, 0U : vol from pool" },
 161     { name => "virStorageVolGetXMLDesc",
 162       sig => "vol, 0U : string" },
 163     { name => "virStorageVolGetPath",
 164       sig => "vol : string" },
 165     { name => "virStorageVolGetKey",
 166       sig => "vol : static string" },
 167     { name => "virStorageVolGetName",
 168       sig => "vol : static string" },
 169     { name => "virStoragePoolLookupByVolume",
 170       sig => "vol : pool from vol" },
 171
 172     );
 173
 174 # Functions we haven't implemented anywhere yet but which are mentioned
 175 # in 'libvirt.ml'.
 176 #
 177 # We create stubs for these, but eventually they need to either be
 178 # moved ^^^ so they are auto-generated, or implementations of them
 179 # written in 'libvirt_c_oneoffs.c'.
 180
 181 my @unimplemented = (
 182     );
 183
 184 #----------------------------------------------------------------------
 185
 186 # Open the output file.
 187
 188 my $filename = "libvirt_c.c";
 189 open F, ">$filename" or die "$filename: $!";
 190
 191 # Write the prologue.
 192
 193 print F <<'END';
 194 /* !!! WARNING WARNING WARNING WARNING WARNING WARNING WARNING !!!
 195  *
 196  * THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
 197  *
 198  * Any changes you make to this file may be overwritten.
 199  */
 200
 201 /* OCaml bindings for libvirt.
 202  * (C) Copyright 2007-2015 Richard W.M. Jones, Red Hat Inc.
 203  * http://libvirt.org/
 204  *
 205  * This library is free software; you can redistribute it and/or
 206  * modify it under the terms of the GNU Lesser General Public
 207  * License as published by the Free Software Foundation; either
 208  * version 2 of the License, or (at your option) any later version,
 209  * with the OCaml linking exception described in ../COPYING.LIB.
 210  *
 211  * This library is distributed in the hope that it will be useful,
 212  * but WITHOUT ANY WARRANTY; without even the implied warranty of
 213  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 214  * Lesser General Public License for more details.
 215  *
 216  * You should have received a copy of the GNU Lesser General Public
 217  * License along with this library; if not, write to the Free Software
 218  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
 219  */
 220
 221 #include "config.h"
 222
 223 #include <stdio.h>
 224 #include <stdlib.h>
 225 #include <string.h>
 226
 227 #include <libvirt/libvirt.h>
 228 #include <libvirt/virterror.h>
 229
 230 #include <caml/config.h>
 231 #include <caml/alloc.h>
 232 #include <caml/callback.h>
 233 #include <caml/custom.h>
 234 #include <caml/fail.h>
 235 #include <caml/memory.h>
 236 #include <caml/misc.h>
 237 #include <caml/mlvalues.h>
 238 #include <caml/signals.h>
 239
 240 #include "libvirt_c_prologue.c"
 241
 242 #include "libvirt_c_oneoffs.c"
 243
 244 END
 245
 246 #----------------------------------------------------------------------
 247
 248 sub camel_case_to_underscores
 249 {
 250     my $name = shift;
 251
 252     $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
 253     my @subs = split (/,/, $name);
 254     @subs = map { lc($_) } @subs;
 255     join "_", @subs
 256 }
 257
 258 # Helper functions dealing with signatures.
 259
 260 sub short_name_to_c_type
 261 {
 262     local $_ = shift;
 263
 264     if ($_ eq "conn") { "virConnectPtr" }
 265     elsif ($_ eq "dom") { "virDomainPtr" }
 266     elsif ($_ eq "net") { "virNetworkPtr" }
 267     elsif ($_ eq "pool") { "virStoragePoolPtr" }
 268     elsif ($_ eq "vol") { "virStorageVolPtr" }
 269     else {
 270         die "unknown short name $_"
 271     }
 272 }
 273
 274 # OCaml argument names.
 275
 276 sub gen_arg_names
 277 {
 278     my $sig = shift;
 279
 280     if ($sig =~ /^(\w+) : string$/) {
 281         ( "$1v" )
 282     } elsif ($sig =~ /^(\w+) : static string$/) {
 283         ( "$1v" )
 284     } elsif ($sig =~ /^(\w+) : int$/) {
 285         ( "$1v" )
 286     } elsif ($sig =~ /^(\w+) : uuid$/) {
 287         ( "$1v" )
 288     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 289         ( "$1v" )
 290     } elsif ($sig =~ /^(\w+) : bool$/) {
 291         ( "$1v" )
 292     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 293         ( "$1v", "bv" )
 294     } elsif ($sig eq "conn, int : int array") {
 295         ( "connv", "iv" )
 296     } elsif ($sig =~ /^(\w+), int : string array$/) {
 297         ( "$1v", "iv" )
 298     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 299         ( "$1v" )
 300     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 301         ( "$1v" )
 302     } elsif ($sig =~ /^(\w+) : unit$/) {
 303         ( "$1v" )
 304     } elsif ($sig =~ /^(\w+) : free$/) {
 305         ( "$1v" )
 306     } elsif ($sig =~ /^(\w+), string : unit$/) {
 307         ( "$1v", "strv" )
 308     } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
 309         ( "$1v", "strv" )
 310     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 311         ( "$1v", "strv" )
 312     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
 313         ( "$1v", "strv" )
 314     } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
 315         ( "$1v", "strv", "uv" )
 316     } elsif ($sig =~ /^(\w+), u?int : (\w+)$/) {
 317         ( "$1v", "iv" )
 318     } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
 319         ( "$1v", "uuidv" )
 320     } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
 321         ( "$1v" )
 322     } elsif ($sig =~ /^(\w+) : (\w+)$/) {
 323         ( "$1v" )
 324     } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) {
 325         ( "$1v", "strv" )
 326     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) {
 327         ( "$1v", "strv" )
 328     } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) {
 329         ( "$1v" )
 330     } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) {
 331         ( "$1v" )
 332     } else {
 333         die "unknown signature $sig"
 334     }
 335 }
 336
 337 # Unpack the first (object) argument.
 338
 339 sub gen_unpack_args
 340 {
 341     local $_ = shift;
 342
 343     if ($_ eq "conn") {
 344         "virConnectPtr conn = Connect_val (connv);"
 345     } elsif ($_ eq "dom") {
 346         "virDomainPtr dom = Domain_val (domv);\n".
 347         "  virConnectPtr conn = Connect_domv (domv);"
 348     } elsif ($_ eq "net") {
 349         "virNetworkPtr net = Network_val (netv);\n".
 350         "  virConnectPtr conn = Connect_netv (netv);"
 351     } elsif ($_ eq "pool") {
 352         "virStoragePoolPtr pool = Pool_val (poolv);\n".
 353         "  virConnectPtr conn = Connect_polv (poolv);"
 354     } elsif ($_ eq "vol") {
 355         "virStorageVolPtr vol = Volume_val (volv);\n".
 356         "  virConnectPtr conn = Connect_volv (volv);"
 357     } else {
 358         die "unknown short name $_"
 359     }
 360 }
 361
 362 # Pack the result if it's an object.
 363
 364 sub gen_pack_result
 365 {
 366     local $_ = shift;
 367
 368     if ($_ eq "dom") {     "rv = Val_domain (r, connv);" }
 369     elsif ($_ eq "net") {  "rv = Val_network (r, connv);" }
 370     elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" }
 371     elsif ($_ eq "vol") {  "rv = Val_volume (r, connv);" }
 372     else {
 373         die "unknown short name $_"
 374     }
 375 }
 376
 377 sub gen_free_arg
 378 {
 379     local $_ = shift;
 380
 381     if ($_ eq "conn") {     "Connect_val (connv) = NULL;" }
 382     elsif ($_ eq "dom") {   "Domain_val (domv) = NULL;" }
 383     elsif ($_ eq "net") {   "Network_val (netv) = NULL;" }
 384     elsif ($_ eq "pool") {  "Pool_val (poolv) = NULL;" }
 385     elsif ($_ eq "vol") {   "Volume_val (volv) = NULL;" }
 386     else {
 387         die "unknown short name $_"
 388     }
 389 }
 390
 391 # Generate the C body for each signature (class of function).
 392
 393 sub gen_c_code
 394 {
 395     my $sig = shift;
 396     my $c_name = shift;
 397
 398     if ($sig =~ /^(\w+) : string$/) {
 399         "\
 400   CAMLlocal1 (rv);
 401   " . gen_unpack_args ($1) . "
 402   char *r;
 403
 404   NONBLOCKING (r = $c_name ($1));
 405   CHECK_ERROR (!r, conn, \"$c_name\");
 406
 407   rv = caml_copy_string (r);
 408   free (r);
 409   CAMLreturn (rv);
 410 "
 411     } elsif ($sig =~ /^(\w+) : static string$/) {
 412         "\
 413   CAMLlocal1 (rv);
 414   " . gen_unpack_args ($1) . "
 415   const char *r;
 416
 417   NONBLOCKING (r = $c_name ($1));
 418   CHECK_ERROR (!r, conn, \"$c_name\");
 419
 420   rv = caml_copy_string (r);
 421   CAMLreturn (rv);
 422 "
 423     } elsif ($sig =~ /^(\w+) : int$/) {
 424         "\
 425   " . gen_unpack_args ($1) . "
 426   int r;
 427
 428   NONBLOCKING (r = $c_name ($1));
 429   CHECK_ERROR (r == -1, conn, \"$c_name\");
 430
 431   CAMLreturn (Val_int (r));
 432 "
 433     } elsif ($sig =~ /^(\w+) : uuid$/) {
 434         "\
 435   CAMLlocal1 (rv);
 436   " . gen_unpack_args ($1) . "
 437   unsigned char uuid[VIR_UUID_BUFLEN];
 438   int r;
 439
 440   NONBLOCKING (r = $c_name ($1, uuid));
 441   CHECK_ERROR (r == -1, conn, \"$c_name\");
 442
 443   /* UUIDs are byte arrays with a fixed length. */
 444   rv = caml_alloc_string (VIR_UUID_BUFLEN);
 445   memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN);
 446   CAMLreturn (rv);
 447 "
 448     } elsif ($sig =~ /^(\w+) : uuid string$/) {
 449         "\
 450   CAMLlocal1 (rv);
 451   " . gen_unpack_args ($1) . "
 452   char uuid[VIR_UUID_STRING_BUFLEN];
 453   int r;
 454
 455   NONBLOCKING (r = $c_name ($1, uuid));
 456   CHECK_ERROR (r == -1, conn, \"$c_name\");
 457
 458   rv = caml_copy_string (uuid);
 459   CAMLreturn (rv);
 460 "
 461     } elsif ($sig =~ /^(\w+) : bool$/) {
 462         "\
 463   " . gen_unpack_args ($1) . "
 464   int r, b;
 465
 466   NONBLOCKING (r = $c_name ($1, &b));
 467   CHECK_ERROR (r == -1, conn, \"$c_name\");
 468
 469   CAMLreturn (b ? Val_true : Val_false);
 470 "
 471     } elsif ($sig =~ /^(\w+), bool : unit$/) {
 472         "\
 473   " . gen_unpack_args ($1) . "
 474   int r, b;
 475
 476   b = bv == Val_true ? 1 : 0;
 477
 478   NONBLOCKING (r = $c_name ($1, b));
 479   CHECK_ERROR (r == -1, conn, \"$c_name\");
 480
 481   CAMLreturn (Val_unit);
 482 "
 483     } elsif ($sig eq "conn, int : int array") {
 484         "\
 485   CAMLlocal1 (rv);
 486   virConnectPtr conn = Connect_val (connv);
 487   int i = Int_val (iv);
 488   int ids[i], r;
 489
 490   /* Some libvirt List* functions still throw exceptions if i == 0,
 491    * so catch that and return an empty array directly.  This changes
 492    * the semantics slightly (masking other failures) but it's
 493    * unlikely anyone will care.  RWMJ 2008/06/10
 494    */
 495   if (i == 0) {
 496     rv = caml_alloc (0, 0);
 497     CAMLreturn (rv);
 498   }
 499
 500   NONBLOCKING (r = $c_name (conn, ids, i));
 501   CHECK_ERROR (r == -1, conn, \"$c_name\");
 502
 503   rv = caml_alloc (r, 0);
 504   for (i = 0; i < r; ++i)
 505     Store_field (rv, i, Val_int (ids[i]));
 506
 507   CAMLreturn (rv);
 508 "
 509     } elsif ($sig =~ /^(\w+), int : string array$/) {
 510         "\
 511   CAMLlocal2 (rv, strv);
 512   " . gen_unpack_args ($1) . "
 513   int i = Int_val (iv);
 514   char *names[i];
 515   int r;
 516
 517   /* Some libvirt List* functions still throw exceptions if i == 0,
 518    * so catch that and return an empty array directly.  This changes
 519    * the semantics slightly (masking other failures) but it's
 520    * unlikely anyone will care.  RWMJ 2008/06/10
 521    */
 522   if (i == 0) {
 523     rv = caml_alloc (0, 0);
 524     CAMLreturn (rv);
 525   }
 526
 527   NONBLOCKING (r = $c_name ($1, names, i));
 528   CHECK_ERROR (r == -1, conn, \"$c_name\");
 529
 530   rv = caml_alloc (r, 0);
 531   for (i = 0; i < r; ++i) {
 532     strv = caml_copy_string (names[i]);
 533     Store_field (rv, i, strv);
 534     free (names[i]);
 535   }
 536
 537   CAMLreturn (rv);
 538 "
 539     } elsif ($sig =~ /^(\w+), 0U? : string$/) {
 540         "\
 541   CAMLlocal1 (rv);
 542   " . gen_unpack_args ($1) . "
 543   char *r;
 544
 545   NONBLOCKING (r = $c_name ($1, 0));
 546   CHECK_ERROR (!r, conn, \"$c_name\");
 547
 548   rv = caml_copy_string (r);
 549   free (r);
 550   CAMLreturn (rv);
 551 "
 552     } elsif ($sig =~ /^(\w+), 0U? : unit$/) {
 553         "\
 554   " . gen_unpack_args ($1) . "
 555   int r;
 556
 557   NONBLOCKING (r = $c_name ($1, 0));
 558   CHECK_ERROR (r == -1, conn, \"$c_name\");
 559
 560   CAMLreturn (Val_unit);
 561 "
 562     } elsif ($sig =~ /^(\w+) : unit$/) {
 563         "\
 564   " . gen_unpack_args ($1) . "
 565   int r;
 566
 567   NONBLOCKING (r = $c_name ($1));
 568   CHECK_ERROR (r == -1, conn, \"$c_name\");
 569
 570   CAMLreturn (Val_unit);
 571 "
 572     } elsif ($sig =~ /^(\w+) : free$/) {
 573         "\
 574   " . gen_unpack_args ($1) . "
 575   int r;
 576
 577   NONBLOCKING (r = $c_name ($1));
 578   CHECK_ERROR (r == -1, conn, \"$c_name\");
 579
 580   /* So that we don't double-free in the finalizer: */
 581   " . gen_free_arg ($1) . "
 582
 583   CAMLreturn (Val_unit);
 584 "
 585     } elsif ($sig =~ /^(\w+), string : unit$/) {
 586         "\
 587   " . gen_unpack_args ($1) . "
 588   char *str = String_val (strv);
 589   int r;
 590
 591   NONBLOCKING (r = $c_name ($1, str));
 592   CHECK_ERROR (r == -1, conn, \"$c_name\");
 593
 594   CAMLreturn (Val_unit);
 595 "
 596     } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) {
 597         "\
 598   CAMLlocal1 (rv);
 599   " . gen_unpack_args ($1) . "
 600   char *str = String_val (strv);
 601   int r;
 602
 603   NONBLOCKING (r = $c_name ($1, str, 0));
 604   CHECK_ERROR (!r, conn, \"$c_name\");
 605
 606   CAMLreturn (Val_unit);
 607 "
 608     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 609         my $c_ret_type = short_name_to_c_type ($2);
 610         "\
 611   CAMLlocal1 (rv);
 612   " . gen_unpack_args ($1) . "
 613   char *str = String_val (strv);
 614   $c_ret_type r;
 615
 616   NONBLOCKING (r = $c_name ($1, str));
 617   CHECK_ERROR (!r, conn, \"$c_name\");
 618
 619   " . gen_pack_result ($2) . "
 620
 621   CAMLreturn (rv);
 622 "
 623     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) {
 624         my $c_ret_type = short_name_to_c_type ($2);
 625         "\
 626   CAMLlocal1 (rv);
 627   " . gen_unpack_args ($1) . "
 628   char *str = String_val (strv);
 629   $c_ret_type r;
 630
 631   NONBLOCKING (r = $c_name ($1, str, 0));
 632   CHECK_ERROR (!r, conn, \"$c_name\");
 633
 634   " . gen_pack_result ($2) . "
 635
 636   CAMLreturn (rv);
 637 "
 638     } elsif ($sig =~ /^(\w+), string, unsigned : (\w+)$/) {
 639         my $c_ret_type = short_name_to_c_type ($2);
 640         "\
 641   CAMLlocal1 (rv);
 642   " . gen_unpack_args ($1) . "
 643   char *str = String_val (strv);
 644   unsigned int u = Int_val (uv);
 645   $c_ret_type r;
 646
 647   NONBLOCKING (r = $c_name ($1, str, u));
 648   CHECK_ERROR (!r, conn, \"$c_name\");
 649
 650   " . gen_pack_result ($2) . "
 651
 652   CAMLreturn (rv);
 653 "
 654     } elsif ($sig =~ /^(\w+), (u?)int : unit$/) {
 655         my $unsigned = $2 eq "u" ? "unsigned " : "";
 656         "\
 657   " . gen_unpack_args ($1) . "
 658   ${unsigned}int i = Int_val (iv);
 659   int r;
 660
 661   NONBLOCKING (r = $c_name ($1, i));
 662   CHECK_ERROR (r == -1, conn, \"$c_name\");
 663
 664   CAMLreturn (Val_unit);
 665 "
 666     } elsif ($sig =~ /^(\w+), (u?)int : (\w+)$/) {
 667         my $c_ret_type = short_name_to_c_type ($3);
 668         my $unsigned = $2 eq "u" ? "unsigned " : "";
 669         "\
 670   CAMLlocal1 (rv);
 671   " . gen_unpack_args ($1) . "
 672   ${unsigned}int i = Int_val (iv);
 673   $c_ret_type r;
 674
 675   NONBLOCKING (r = $c_name ($1, i));
 676   CHECK_ERROR (!r, conn, \"$c_name\");
 677
 678   " . gen_pack_result ($3) . "
 679
 680   CAMLreturn (rv);
 681 "
 682     } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) {
 683         my $c_ret_type = short_name_to_c_type ($2);
 684         "\
 685   CAMLlocal1 (rv);
 686   " . gen_unpack_args ($1) . "
 687   unsigned char *uuid = (unsigned char *) String_val (uuidv);
 688   $c_ret_type r;
 689
 690   NONBLOCKING (r = $c_name ($1, uuid));
 691   CHECK_ERROR (!r, conn, \"$c_name\");
 692
 693   " . gen_pack_result ($2) . "
 694
 695   CAMLreturn (rv);
 696 "
 697     } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) {
 698         my $c_ret_type = short_name_to_c_type ($2);
 699         "\
 700   CAMLlocal1 (rv);
 701   " . gen_unpack_args ($1) . "
 702   $c_ret_type r;
 703
 704   NONBLOCKING (r = $c_name ($1, 0));
 705   CHECK_ERROR (!r, conn, \"$c_name\");
 706
 707   " . gen_pack_result ($2) . "
 708
 709   CAMLreturn (rv);
 710 "
 711     } elsif ($sig =~ /^(\w+) : (\w+)$/) {
 712         my $c_ret_type = short_name_to_c_type ($2);
 713         "\
 714   CAMLlocal1 (rv);
 715   " . gen_unpack_args ($1) . "
 716   $c_ret_type r;
 717
 718   NONBLOCKING (r = $c_name ($1));
 719   CHECK_ERROR (!r, conn, \"$c_name\");
 720
 721   " . gen_pack_result ($2) . "
 722
 723   CAMLreturn (rv);
 724 "
 725     } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) {
 726         my $c_ret_type = short_name_to_c_type ($2);
 727         "\
 728   CAMLlocal2 (rv, connv);
 729   " . gen_unpack_args ($1) . "
 730   char *str = String_val (strv);
 731   $c_ret_type r;
 732
 733   NONBLOCKING (r = $c_name ($1, str));
 734   CHECK_ERROR (!r, conn, \"$c_name\");
 735
 736   connv = Field ($3v, 1);
 737   " . gen_pack_result ($2) . "
 738
 739   CAMLreturn (rv);
 740 "
 741     } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) {
 742         my $c_ret_type = short_name_to_c_type ($2);
 743         "\
 744   CAMLlocal2 (rv, connv);
 745   " . gen_unpack_args ($1) . "
 746   char *str = String_val (strv);
 747   $c_ret_type r;
 748
 749   NONBLOCKING (r = $c_name ($1, str, 0));
 750   CHECK_ERROR (!r, conn, \"$c_name\");
 751
 752   connv = Field ($3v, 1);
 753   " . gen_pack_result ($2) . "
 754
 755   CAMLreturn (rv);
 756 "
 757     } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) {
 758         my $c_ret_type = short_name_to_c_type ($2);
 759         "\
 760   CAMLlocal2 (rv, connv);
 761   " . gen_unpack_args ($1) . "
 762   $c_ret_type r;
 763
 764   NONBLOCKING (r = $c_name ($1, 0));
 765   CHECK_ERROR (!r, conn, \"$c_name\");
 766
 767   connv = Field ($3v, 1);
 768   " . gen_pack_result ($2) . "
 769
 770   CAMLreturn (rv);
 771 "
 772     } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) {
 773         my $c_ret_type = short_name_to_c_type ($2);
 774         "\
 775   CAMLlocal2 (rv, connv);
 776   " . gen_unpack_args ($1) . "
 777   $c_ret_type r;
 778
 779   NONBLOCKING (r = $c_name ($1));
 780   CHECK_ERROR (!r, conn, \"$c_name\");
 781
 782   connv = Field ($3v, 1);
 783   " . gen_pack_result ($2) . "
 784
 785   CAMLreturn (rv);
 786 "
 787     } else {
 788         die "unknown signature $sig"
 789     }
 790 }
 791
 792 # Generate each function.
 793
 794 foreach my $function (@functions) {
 795     my $c_name = $function->{name};
 796     my $sig = $function->{sig};
 797
 798     #print "generating $c_name with sig \"$sig\" ...\n";
 799
 800     #my $is_pool_func = $c_name =~ /^virStoragePool/;
 801     #my $is_vol_func = $c_name =~ /^virStorageVol/;
 802
 803     # Generate an equivalent C-external name for the function, unless
 804     # one is defined already.
 805     my $c_external_name;
 806     if (exists ($function->{c_external_name})) {
 807         $c_external_name = $function->{c_external_name};
 808     } elsif ($c_name =~ /^vir/) {
 809         $c_external_name = substr $c_name, 3;
 810         $c_external_name = camel_case_to_underscores ($c_external_name);
 811         $c_external_name = "ocaml_libvirt_" . $c_external_name;
 812     } else {
 813         die "cannot convert c_name $c_name to c_external_name"
 814     }
 815
 816     print F <<END;
 817 /* Automatically generated binding for $c_name.
 818  * In generator.pl this function has signature "$sig".
 819  */
 820
 821 END
 822
 823     my @arg_names = gen_arg_names ($sig);
 824     my $nr_arg_names = scalar @arg_names;
 825     my $arg_names = join ", ", @arg_names;
 826     my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
 827
 828     # Generate the start of the function, arguments.
 829     print F <<END;
 830 CAMLprim value
 831 $c_external_name ($arg_names_as_values)
 832 {
 833   CAMLparam$nr_arg_names ($arg_names);
 834 END
 835
 836     # Generate the internals of the function.
 837     print F (gen_c_code ($sig, $c_name));
 838
 839     # Finish off the function.
 840     print F <<END;
 841 }
 842
 843 END
 844 }
 845
 846 #----------------------------------------------------------------------
 847
 848 # Unimplemented functions.
 849
 850 if (@unimplemented) {
 851     printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
 852
 853     print F <<'END';
 854 /* The following functions are unimplemented and always fail.
 855  * See generator.pl '@unimplemented'
 856  */
 857
 858 END
 859
 860     foreach my $c_external_name (@unimplemented) {
 861         print F <<END;
 862 CAMLprim value
 863 $c_external_name ()
 864 {
 865   failwith ("$c_external_name is unimplemented");
 866 }
 867
 868 END
 869     } # end foreach
 870 } # end if @unimplemented
 871
 872 #----------------------------------------------------------------------
 873
 874 # Write the epilogue.
 875
 876 print F <<'END';
 877 #include "libvirt_c_epilogue.c"
 878
 879 /* EOF */
 880 END
 881
 882 close F;
 883 print "$0: written $filename\n"
 884