libvirt/generator.pl

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