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