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