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