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 use strict;
  26
  27 #----------------------------------------------------------------------
  28
  29 # The functions in the libvirt API that we can generate.
  30
  31 my @functions = (
  32     { name => "virConnectGetHostname", sig => "conn : string", weak => 1 },
  33     { name => "virConnectGetURI", sig => "conn : string", weak => 1 },
  34     { name => "virConnectGetType", sig => "conn : static string" },
  35     { name => "virConnectNumOfDomains", sig => "conn : int" },
  36     { name => "virConnectListDomains", sig => "conn, int : int array" },
  37     { name => "virConnectNumOfDefinedDomains", sig => "conn : int" },
  38     { name => "virConnectListDefinedDomains",
  39       sig => "conn, int : string array" },
  40     { name => "virConnectNumOfNetworks", sig => "conn : int" },
  41     { name => "virConnectListNetworks", sig => "conn, int : string array" },
  42     { name => "virConnectNumOfDefinedNetworks", sig => "conn : int" },
  43     { name => "virConnectListDefinedNetworks",
  44       sig => "conn, int : string array" },
  45     { name => "virConnectNumOfStoragePools", sig => "conn : int", weak => 1 },
  46     { name => "virConnectListStoragePools",
  47       sig => "conn, int : string array", weak => 1 },
  48     { name => "virConnectNumOfDefinedStoragePools",
  49       sig => "conn : int", weak => 1 },
  50     { name => "virConnectListDefinedStoragePools",
  51       sig => "conn, int : string array", weak => 1 },
  52     { name => "virConnectGetCapabilities", sig => "conn : string" },
  53
  54     { name => "virDomainLookupByName", sig => "conn, string : dom" },
  55     { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" },
  56     { name => "virDomainGetName", sig => "dom : static string" },
  57     { name => "virDomainGetOSType", sig => "dom : string" },
  58     { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" },
  59     { name => "virDomainSuspend", sig => "dom : unit" },
  60     { name => "virDomainResume", sig => "dom : unit" },
  61     { name => "virDomainShutdown", sig => "dom : unit" },
  62     { name => "virDomainReboot", sig => "dom, 0 : unit" },
  63     { name => "virDomainUndefine", sig => "dom : unit" },
  64     { name => "virDomainCreate", sig => "dom : unit" },
  65
  66     { name => "virNetworkLookupByName", sig => "conn, string : net" },
  67     { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" },
  68     { name => "virNetworkGetName", sig => "net : static string" },
  69     { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" },
  70     { name => "virNetworkGetBridgeName", sig => "net : string" },
  71     { name => "virNetworkUndefine", sig => "net : unit" },
  72     { name => "virNetworkCreate", sig => "net : unit" },
  73
  74     { name => "virStoragePoolLookupByName",
  75       sig => "conn, string : pool", weak => 1 },
  76     { name => "virStoragePoolLookupByUUIDString",
  77       sig => "conn, string : pool", weak => 1 },
  78     { name => "virStoragePoolGetName",
  79       sig => "pool : static string", weak => 1 },
  80     { name => "virStoragePoolGetXMLDesc",
  81       sig => "pool, 0 : string", weak => 1 },
  82     { name => "virStoragePoolUndefine",
  83       sig => "pool : string", weak => 1 },
  84     { name => "virStoragePoolCreate",
  85       sig => "pool : string", weak => 1 },
  86     { name => "virStoragePoolShutdown",
  87       sig => "pool : string", weak => 1 },
  88     { name => "virStoragePoolRefresh",
  89       sig => "pool, 0 : string", weak => 1 },
  90
  91     { name => "virStorageVolLookupByName",
  92       sig => "conn, string : vol", weak => 1 },
  93     { name => "virStorageVolLookupByKey",
  94       sig => "conn, string : vol", weak => 1 },
  95     { name => "virStorageVolLookupByPath",
  96       sig => "conn, string : vol", weak => 1 },
  97     { name => "virStorageVolGetXMLDesc",
  98       sig => "pool, 0 : string", weak => 1 },
  99     { name => "virStorageVolGetPath",
 100       sig => "pool : string", weak => 1 },
 101     { name => "virStorageVolGetKey",
 102       sig => "pool : static string", weak => 1 },
 103     { name => "virStorageVolGetName",
 104       sig => "pool : static string", weak => 1 },
 105
 106     );
 107
 108 # Functions we haven't implemented anywhere yet.
 109 # We create stubs for these, but they need to either be moved ^^ so they
 110 # are auto-generated or implementations written in libvirt_c_oneoffs.c.
 111
 112 my @unimplemented = (
 113     "ocaml_libvirt_domain_create_job",
 114     "ocaml_libvirt_domain_core_dump_job",
 115     "ocaml_libvirt_domain_restore_job",
 116     "ocaml_libvirt_domain_save_job",
 117     "ocaml_libvirt_connect_create_linux_job",
 118     "ocaml_libvirt_network_create_job",
 119     "ocaml_libvirt_network_create_xml_job",
 120     "ocaml_libvirt_storage_pool_set_autostart",
 121     "ocaml_libvirt_storage_pool_get_autostart",
 122     "ocaml_libvirt_storage_pool_get_info",
 123     "ocaml_libvirt_storage_pool_get_uuid_string",
 124     "ocaml_libvirt_storage_pool_get_uuid",
 125     "ocaml_libvirt_storage_pool_free",
 126     "ocaml_libvirt_storage_pool_destroy",
 127     "ocaml_libvirt_storage_pool_define_xml",
 128     "ocaml_libvirt_storage_pool_create_xml",
 129     "ocaml_libvirt_storage_pool_lookup_by_uuid",
 130     "ocaml_libvirt_storage_vol_free",
 131     "ocaml_libvirt_storage_vol_destroy",
 132     "ocaml_libvirt_storage_vol_create_xml",
 133     "ocaml_libvirt_storage_vol_get_info",
 134     "ocaml_libvirt_pool_of_volume",
 135     "ocaml_libvirt_job_cancel",
 136     "ocaml_libvirt_job_get_network",
 137     "ocaml_libvirt_job_get_domain",
 138     "ocaml_libvirt_job_get_info",
 139     );
 140
 141 #----------------------------------------------------------------------
 142
 143 # Open the output file.
 144
 145 my $filename = "libvirt_c.c";
 146 open F, ">$filename" or die "$filename: $!";
 147
 148 # Write the prologue.
 149
 150 print F <<'END';
 151 /* WARNING: THIS FILE IS AUTOMATICALLY GENERATED BY 'generator.pl'.
 152  * Any changes you make to this file may be overwritten.
 153  */
 154
 155 /* OCaml bindings for libvirt.
 156  * (C) Copyright 2007-2008 Richard W.M. Jones, Red Hat Inc.
 157  * http://libvirt.org/
 158  *
 159  * This library is free software; you can redistribute it and/or
 160  * modify it under the terms of the GNU Lesser General Public
 161  * License as published by the Free Software Foundation; either
 162  * version 2 of the License, or (at your option) any later version.
 163  *
 164  * This library is distributed in the hope that it will be useful,
 165  * but WITHOUT ANY WARRANTY; without even the implied warranty of
 166  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 167  * Lesser General Public License for more details.
 168  *
 169  * You should have received a copy of the GNU Lesser General Public
 170  * License along with this library; if not, write to the Free Software
 171  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301  USA
 172  */
 173
 174 #include "config.h"
 175
 176 #include <stdio.h>
 177 #include <stdlib.h>
 178 #include <string.h>
 179
 180 #include <libvirt/libvirt.h>
 181 #include <libvirt/virterror.h>
 182
 183 #include <caml/config.h>
 184 #include <caml/alloc.h>
 185 #include <caml/callback.h>
 186 #include <caml/custom.h>
 187 #include <caml/fail.h>
 188 #include <caml/memory.h>
 189 #include <caml/misc.h>
 190 #include <caml/mlvalues.h>
 191 #include <caml/signals.h>
 192
 193 #include "libvirt_c_prologue.c"
 194
 195 #include "libvirt_c_oneoffs.c"
 196
 197 END
 198
 199 #----------------------------------------------------------------------
 200
 201 sub camel_case_to_underscores
 202 {
 203     my $name = shift;
 204
 205     $name =~ s/([A-Z][a-z]+|XML|URI|OS|UUID)/$1,/g;
 206     my @subs = split (/,/, $name);
 207     @subs = map { lc($_) } @subs;
 208     join "_", @subs
 209 }
 210
 211 # Helper functions dealing with signatures.
 212
 213 sub short_name_to_c_type
 214 {
 215     local $_ = shift;
 216
 217     if ($_ eq "conn") { "virConnectPtr" }
 218     elsif ($_ eq "dom") { "virDomainPtr" }
 219     elsif ($_ eq "net") { "virNetworkPtr" }
 220     elsif ($_ eq "pool") { "virStoragePoolPtr" }
 221     elsif ($_ eq "vol") { "virStorageVolPtr" }
 222     else {
 223         die "unknown short name $_"
 224     }
 225 }
 226
 227 sub gen_c_signature
 228 {
 229     my $sig = shift;
 230     my $c_name = shift;
 231
 232     if ($sig =~ /^(\w+) : string$/) {
 233         my $c_type = short_name_to_c_type ($1);
 234         "char *$c_name ($c_type $1)"
 235     } elsif ($sig =~ /^(\w+) : static string$/) {
 236         my $c_type = short_name_to_c_type ($1);
 237         "const char *$c_name ($c_type $1)"
 238     } elsif ($sig =~ /^(\w+) : int$/) {
 239         my $c_type = short_name_to_c_type ($1);
 240         "int $c_name ($c_type $1)"
 241     } elsif ($sig eq "conn, int : int array") {
 242         "int $c_name (virConnectPtr conn, int *ids, int maxids)"
 243     } elsif ($sig eq "conn, int : string array") {
 244         "int $c_name (virConnectPtr conn, char **const names, int maxnames)"
 245     } elsif ($sig =~ /^(\w+), 0 : string$/) {
 246         my $c_type = short_name_to_c_type ($1);
 247         "char *$c_name ($c_type $1, int flags)"
 248     } elsif ($sig =~ /^(\w+), 0 : unit$/) {
 249         my $c_type = short_name_to_c_type ($1);
 250         "int $c_name ($c_type $1, int flags)"
 251     } elsif ($sig =~ /^(\w+) : unit$/) {
 252         my $c_type = short_name_to_c_type ($1);
 253         "int $c_name ($c_type $1 dom)"
 254     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 255         my $c_type = short_name_to_c_type ($1);
 256         my $c_ret_type = short_name_to_c_type ($2);
 257         "$c_ret_type $c_name ($c_type $1 dom)"
 258     } else {
 259         die "unknown signature $sig"
 260     }
 261 }
 262
 263 sub gen_arg_names
 264 {
 265     my $sig = shift;
 266
 267     if ($sig =~ /^(\w+) : string$/) {
 268         ( "$1v" )
 269     } elsif ($sig =~ /^(\w+) : static string$/) {
 270         ( "$1v" )
 271     } elsif ($sig =~ /^(\w+) : int$/) {
 272         ( "$1v" )
 273     } elsif ($sig eq "conn, int : int array") {
 274         ( "connv", "iv" )
 275     } elsif ($sig eq "conn, int : string array") {
 276         ( "connv", "iv" )
 277     } elsif ($sig =~ /^(\w+), 0 : string$/) {
 278         ( "$1v" )
 279     } elsif ($sig =~ /^(\w+), 0 : unit$/) {
 280         ( "$1v" )
 281     } elsif ($sig =~ /^(\w+) : unit$/) {
 282         ( "$1v" )
 283     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 284         ( "$1v", "strv" )
 285     } else {
 286         die "unknown signature $sig"
 287     }
 288 }
 289
 290 sub gen_unpack_args
 291 {
 292     local $_ = shift;
 293
 294     if ($_ eq "conn") {
 295         "virConnectPtr conn = Connect_val (connv);"
 296     } elsif ($_ eq "dom") {
 297         "virDomainPtr dom = Domain_val (domv);\n".
 298         "  virConnectPtr conn = Connect_domv (domv);"
 299     } elsif ($_ eq "net") {
 300         "virNetworkPtr net = Network_val (netv);\n".
 301         "  virConnectPtr conn = Connect_netv (netv);"
 302     } elsif ($_ eq "pool") {
 303         "virStoragePoolPtr pool = Pool_val (poolv);\n".
 304         "  virConnectPtr conn = Connect_polv (poolv);"
 305     } elsif ($_ eq "vol") {
 306         "virStorageVolPtr vol = Volume_val (volv);\n".
 307         "  virConnectPtr conn = Connect_volv (volv);"
 308     } else {
 309         die "unknown short name $_"
 310     }
 311 }
 312
 313 sub gen_pack_result
 314 {
 315     local $_ = shift;
 316
 317     if ($_ eq "dom") {
 318         "rv = Val_domain (r, connv);"
 319     } elsif ($_ eq "net") {
 320         "rv = Val_network (r, connv);"
 321     } elsif ($_ eq "pool") {
 322         "rv = Val_pool (r, connv);"
 323     } elsif ($_ eq "vol") {
 324         "rv = Val_volume (r, connv);"
 325     }
 326 }
 327
 328 sub gen_c_code
 329 {
 330     my $sig = shift;
 331     my $c_name = shift;
 332
 333     if ($sig =~ /^(\w+) : string$/) {
 334         "\
 335   CAMLlocal1 (rv);
 336   " . gen_unpack_args ($1) . "
 337   char *r;
 338
 339   NONBLOCKING (r = $c_name ($1));
 340   CHECK_ERROR (!r, conn, \"$c_name\");
 341
 342   rv = caml_copy_string (r);
 343   free (r);
 344   CAMLreturn (rv);
 345 "
 346     } elsif ($sig =~ /^(\w+) : static string$/) {
 347         "\
 348   CAMLlocal1 (rv);
 349   " . gen_unpack_args ($1) . "
 350   const char *r;
 351
 352   NONBLOCKING (r = $c_name ($1));
 353   CHECK_ERROR (!r, conn, \"$c_name\");
 354
 355   rv = caml_copy_string (r);
 356   CAMLreturn (rv);
 357 "
 358     } elsif ($sig =~ /^(\w+) : int$/) {
 359         "\
 360   " . gen_unpack_args ($1) . "
 361   int r;
 362
 363   NONBLOCKING (r = $c_name ($1));
 364   CHECK_ERROR (r == -1, conn, \"$c_name\");
 365
 366   CAMLreturn (Val_int (r));
 367 "
 368     } elsif ($sig eq "conn, int : int array") {
 369         "\
 370   CAMLlocal1 (rv);
 371   virConnectPtr conn = Connect_val (connv);
 372   int i = Int_val (iv);
 373   int ids[i], r;
 374
 375   NONBLOCKING (r = $c_name (conn, ids, i));
 376   CHECK_ERROR (r == -1, conn, \"$c_name\");
 377
 378   rv = caml_alloc (r, 0);
 379   for (i = 0; i < r; ++i)
 380     Store_field (rv, i, Val_int (ids[i]));
 381
 382   CAMLreturn (rv);
 383 "
 384     } elsif ($sig eq "conn, int : string array") {
 385         "\
 386   CAMLlocal2 (rv, strv);
 387   virConnectPtr conn = Connect_val (connv);
 388   int i = Int_val (iv);
 389   char *names[i];
 390   int r;
 391
 392   NONBLOCKING (r = $c_name (conn, names, i));
 393   CHECK_ERROR (r == -1, conn, \"$c_name\");
 394
 395   rv = caml_alloc (r, 0);
 396   for (i = 0; i < r; ++i) {
 397     strv = caml_copy_string (names[i]);
 398     Store_field (rv, i, strv);
 399     free (names[i]);
 400   }
 401
 402   CAMLreturn (rv);
 403 "
 404     } elsif ($sig =~ /^(\w+), 0 : string$/) {
 405         "\
 406   CAMLlocal1 (rv);
 407   " . gen_unpack_args ($1) . "
 408   char *r;
 409
 410   NONBLOCKING (r = $c_name ($1, 0));
 411   CHECK_ERROR (!r, conn, \"$c_name\");
 412
 413   rv = caml_copy_string (r);
 414   free (r);
 415   CAMLreturn (rv);
 416 "
 417     } elsif ($sig =~ /^(\w+) : unit$/) {
 418         "\
 419   " . gen_unpack_args ($1) . "
 420   int r;
 421
 422   NONBLOCKING (r = $c_name ($1));
 423   CHECK_ERROR (r == -1, conn, \"$c_name\");
 424
 425   CAMLreturn (Val_unit);
 426 "
 427     } elsif ($sig =~ /^(\w+), 0 : unit$/) {
 428         "\
 429   " . gen_unpack_args ($1) . "
 430   int r;
 431
 432   NONBLOCKING (r = $c_name ($1, 0));
 433   CHECK_ERROR (r == -1, conn, \"$c_name\");
 434
 435   CAMLreturn (Val_unit);
 436 "
 437     } elsif ($sig =~ /^(\w+), string : (\w+)$/) {
 438         my $c_ret_type = short_name_to_c_type ($2);
 439         "\
 440   CAMLlocal1 (rv);
 441   " . gen_unpack_args ($1) . "
 442   char *str = String_val (strv);
 443   $c_ret_type r;
 444
 445   NONBLOCKING (r = $c_name ($1, str));
 446   CHECK_ERROR (!r, conn, \"$c_name\");
 447
 448   " . gen_pack_result ($2) . "
 449
 450   CAMLreturn (rv);
 451 "
 452     } else {
 453         die "unknown signature $sig"
 454     }
 455 }
 456
 457 # Generate each function.
 458
 459 foreach my $function (@functions) {
 460     my $c_name = $function->{name};
 461     my $is_weak = $function->{weak};
 462     my $sig = $function->{sig};
 463
 464     my $is_pool_func = $c_name =~ /^virStoragePool/;
 465     my $is_vol_func = $c_name =~ /^virStorageVol/;
 466
 467     # Generate an equivalent C-external name for the function, unless
 468     # one is defined already.
 469     my $c_external_name;
 470     if (exists ($function->{c_external_name})) {
 471         $c_external_name = $function->{c_external_name};
 472     } elsif ($c_name =~ /^vir/) {
 473         $c_external_name = substr $c_name, 3;
 474         $c_external_name = camel_case_to_underscores ($c_external_name);
 475         $c_external_name = "ocaml_libvirt_" . $c_external_name;
 476     } else {
 477         die "cannot convert c_name $c_name to c_external_name"
 478     }
 479
 480     # Generate a full function prototype if the function is weak.
 481     my $have_name = "HAVE_" . uc ($c_name);
 482     if ($is_weak) {
 483         my $c_sig = gen_c_signature ($sig, $c_name);
 484         print F <<END;
 485 #ifdef HAVE_WEAK_SYMBOLS
 486 #ifdef $have_name
 487 extern $c_sig __attribute__((weak));
 488 #endif
 489 #endif
 490
 491 END
 492     }
 493
 494     my @arg_names = gen_arg_names ($sig);
 495     my $nr_arg_names = scalar @arg_names;
 496     my $arg_names = join ", ", @arg_names;
 497     my $arg_names_as_values = join (", ", map { "value $_" } @arg_names);
 498
 499     # Generate the start of the function, arguments.
 500     print F <<END;
 501 CAMLprim value
 502 $c_external_name ($arg_names_as_values)
 503 {
 504   CAMLparam$nr_arg_names ($arg_names);
 505 END
 506
 507     # If weak, check the function exists at compile time or runtime.
 508     if ($is_weak) {
 509         print F <<END;
 510 #ifndef $have_name
 511   /* Symbol $c_name not found at compile time. */
 512   not_supported ("$c_name");
 513   /* Suppresses a compiler warning. */
 514   (void) caml__frame;
 515 #else
 516   /* Check that the symbol $c_name
 517    * is in runtime version of libvirt.
 518    */
 519   WEAK_SYMBOL_CHECK ($c_name);
 520 END
 521     }
 522
 523     # Generate the internals of the function.
 524     print F (gen_c_code ($sig, $c_name));
 525
 526     # Finish off weak #ifdef.
 527     if ($is_weak) {
 528         print F <<END;
 529 #endif
 530 END
 531     }
 532
 533     # Finish off the function.
 534     print F <<END;
 535 }
 536
 537 END
 538 }
 539
 540 #----------------------------------------------------------------------
 541
 542 # Unimplemented functions.
 543
 544 printf "$0: warning: %d unimplemented functions\n", scalar (@unimplemented);
 545
 546 foreach my $c_external_name (@unimplemented) {
 547     print F <<END
 548 CAMLprim value
 549 $c_external_name ()
 550 {
 551   failwith ("$c_external_name is unimplemented");
 552 }
 553
 554 END
 555 }
 556
 557 #----------------------------------------------------------------------
 558
 559 # Write the epilogue.
 560
 561 print F <<'END';
 562 #include "libvirt_c_epilogue.c"
 563
 564 /* EOF */
 565 END
 566
 567 close F;
 568 print "$0: written $filename\n"
 569