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