X-Git-Url: http://git.annexia.org/?p=virt-top.git;a=blobdiff_plain;f=libvirt%2Fgenerator.pl;h=8b20adf31e9eca192c59343b0d2e6f45dfdb6bff;hp=4fd07b8e00e7cfbe4f301da2cb8852e1a6bbf49e;hb=e7c94d95feb1fb3d7249c2ead935fe2e56ec31a4;hpb=b6098f4c7419486227cbe2112904cbc9d58ed787 diff --git a/libvirt/generator.pl b/libvirt/generator.pl index 4fd07b8..8b20adf 100755 --- a/libvirt/generator.pl +++ b/libvirt/generator.pl @@ -21,6 +21,8 @@ # This generates libvirt_c.c (the core of the bindings). You don't # need to run this program unless you are extending the bindings # themselves (eg. because libvirt has been extended). +# +# Please read libvirt/README. use strict; @@ -28,7 +30,15 @@ use strict; # The functions in the libvirt API that we can generate. +# The 'sig' (signature) doesn't have a meaning or any internal structure. +# It is interpreted by the generation functions below to indicate what +# "class" the function falls into, and to generate the right class of +# binding. +# +# Any function added since libvirt 0.2.1 must be marked weak. + my @functions = ( + { name => "virConnectClose", sig => "conn : free" }, { name => "virConnectGetHostname", sig => "conn : string", weak => 1 }, { name => "virConnectGetURI", sig => "conn : string", weak => 1 }, { name => "virConnectGetType", sig => "conn : static string" }, @@ -51,23 +61,48 @@ my @functions = ( sig => "conn, int : string array", weak => 1 }, { name => "virConnectGetCapabilities", sig => "conn : string" }, + { name => "virDomainCreateLinux", sig => "conn, string, 0U : dom" }, + { name => "virDomainCreateLinuxJob", + sig => "conn, string, 0U : job", weak => 1 }, + { name => "virDomainFree", sig => "dom : free" }, + { name => "virDomainDestroy", sig => "dom : free" }, { name => "virDomainLookupByName", sig => "conn, string : dom" }, + { name => "virDomainLookupByID", sig => "conn, int : dom" }, + { name => "virDomainLookupByUUID", sig => "conn, uuid : dom" }, { name => "virDomainLookupByUUIDString", sig => "conn, string : dom" }, { name => "virDomainGetName", sig => "dom : static string" }, { name => "virDomainGetOSType", sig => "dom : string" }, { name => "virDomainGetXMLDesc", sig => "dom, 0 : string" }, { name => "virDomainGetUUID", sig => "dom : uuid" }, { name => "virDomainGetUUIDString", sig => "dom : uuid string" }, + { name => "virDomainGetMaxVcpus", sig => "dom : int" }, + { name => "virDomainSave", sig => "dom, string : unit" }, + { name => "virDomainSaveJob", + sig => "dom, string : job from dom", weak => 1 }, + { name => "virDomainRestore", sig => "conn, string : unit" }, + { name => "virDomainRestoreJob", + sig => "conn, string : job", weak => 1 }, + { name => "virDomainCoreDump", sig => "dom, string, 0 : unit" }, + { name => "virDomainCoreDumpJob", + sig => "dom, string, 0 : job from dom", weak => 1 }, { name => "virDomainSuspend", sig => "dom : unit" }, { name => "virDomainResume", sig => "dom : unit" }, { name => "virDomainShutdown", sig => "dom : unit" }, { name => "virDomainReboot", sig => "dom, 0 : unit" }, + { name => "virDomainDefineXML", sig => "conn, string : dom" }, { name => "virDomainUndefine", sig => "dom : unit" }, { name => "virDomainCreate", sig => "dom : unit" }, + { name => "virDomainCreateJob", + sig => "dom, 0U : job from dom", weak => 1 }, + { name => "virDomainAttachDevice", sig => "dom, string : unit" }, + { name => "virDomainDetachDevice", sig => "dom, string : unit" }, { name => "virDomainGetAutostart", sig => "dom : bool" }, { name => "virDomainSetAutostart", sig => "dom, bool : unit" }, + { name => "virNetworkFree", sig => "net : free" }, + { name => "virNetworkDestroy", sig => "net : free" }, { name => "virNetworkLookupByName", sig => "conn, string : net" }, + { name => "virNetworkLookupByUUID", sig => "conn, uuid : net" }, { name => "virNetworkLookupByUUIDString", sig => "conn, string : net" }, { name => "virNetworkGetName", sig => "net : static string" }, { name => "virNetworkGetXMLDesc", sig => "net, 0 : string" }, @@ -75,12 +110,22 @@ my @functions = ( { name => "virNetworkGetUUID", sig => "net : uuid" }, { name => "virNetworkGetUUIDString", sig => "net : uuid string" }, { name => "virNetworkUndefine", sig => "net : unit" }, + { name => "virNetworkCreateXML", sig => "conn, string : net" }, + { name => "virNetworkCreateXMLJob", + sig => "conn, string : job", weak => 1 }, + { name => "virNetworkDefineXML", sig => "conn, string : net" }, { name => "virNetworkCreate", sig => "net : unit" }, + { name => "virNetworkCreateJob", + sig => "net : job from net", weak => 1 }, { name => "virNetworkGetAutostart", sig => "net : bool" }, { name => "virNetworkSetAutostart", sig => "net, bool : unit" }, + { name => "virStoragePoolFree", sig => "pool : free", weak => 1 }, + { name => "virStoragePoolDestroy", sig => "pool : free", weak => 1 }, { name => "virStoragePoolLookupByName", sig => "conn, string : pool", weak => 1 }, + { name => "virStoragePoolLookupByUUID", + sig => "conn, uuid : pool", weak => 1 }, { name => "virStoragePoolLookupByUUIDString", sig => "conn, string : pool", weak => 1 }, { name => "virStoragePoolGetName", @@ -91,6 +136,10 @@ my @functions = ( sig => "pool : uuid", weak => 1 }, { name => "virStoragePoolGetUUIDString", sig => "pool : uuid string", weak => 1 }, + { name => "virStoragePoolCreateXML", + sig => "conn, string : pool", weak => 1 }, + { name => "virStoragePoolDefineXML", + sig => "conn, string : pool", weak => 1 }, { name => "virStoragePoolUndefine", sig => "pool : unit", weak => 1 }, { name => "virStoragePoolCreate", @@ -104,12 +153,16 @@ my @functions = ( { name => "virStoragePoolSetAutostart", sig => "pool, bool : unit", weak => 1 }, -# { name => "virStorageVolLookupByName", XXX see libvir-list posting -# sig => "pool, string : vol", weak => 1 }, + { name => "virStorageVolFree", sig => "vol : free", weak => 1 }, + { name => "virStorageVolDestroy", sig => "vol : free", weak => 1 }, + { name => "virStorageVolLookupByName", + sig => "pool, string : vol from pool", weak => 1 }, { name => "virStorageVolLookupByKey", sig => "conn, string : vol", weak => 1 }, { name => "virStorageVolLookupByPath", sig => "conn, string : vol", weak => 1 }, + { name => "virStorageVolCreateXML", + sig => "pool, string, 0 : vol from pool", weak => 1 }, { name => "virStorageVolGetXMLDesc", sig => "vol, 0 : string", weak => 1 }, { name => "virStorageVolGetPath", @@ -118,37 +171,28 @@ my @functions = ( sig => "vol : static string", weak => 1 }, { name => "virStorageVolGetName", sig => "vol : static string", weak => 1 }, + { name => "virStoragePoolLookupByVolume", + sig => "vol : pool from vol", weak => 1 }, + + { name => "virJobFree", + sig => "job : free", weak => 1 }, + { name => "virJobCancel", + sig => "job : unit", weak => 1 }, + { name => "virJobGetNetwork", + sig => "job : net from job", weak => 1 }, + { name => "virJobGetDomain", + sig => "job : dom from job", weak => 1 }, ); -# Functions we haven't implemented anywhere yet. -# We create stubs for these, but they need to either be moved ^^ so they -# are auto-generated or implementations written in libvirt_c_oneoffs.c. +# Functions we haven't implemented anywhere yet but which are mentioned +# in 'libvirt.ml'. +# +# We create stubs for these, but eventually they need to either be +# moved ^^^ so they are auto-generated, or implementations of them +# written in 'libvirt_c_oneoffs.c'. my @unimplemented = ( - "ocaml_libvirt_domain_create_job", - "ocaml_libvirt_domain_core_dump_job", - "ocaml_libvirt_domain_restore_job", - "ocaml_libvirt_domain_save_job", - "ocaml_libvirt_connect_create_linux_job", - "ocaml_libvirt_network_create_job", - "ocaml_libvirt_network_create_xml_job", - "ocaml_libvirt_storage_pool_get_info", - "ocaml_libvirt_storage_pool_free", #? - "ocaml_libvirt_storage_pool_destroy", #? - "ocaml_libvirt_storage_pool_define_xml", - "ocaml_libvirt_storage_pool_create_xml", - "ocaml_libvirt_storage_pool_lookup_by_uuid", - "ocaml_libvirt_storage_vol_lookup_by_name", # XXX - "ocaml_libvirt_storage_vol_free", #? - "ocaml_libvirt_storage_vol_destroy", #? - "ocaml_libvirt_storage_vol_create_xml", - "ocaml_libvirt_storage_vol_get_info", - "ocaml_libvirt_pool_of_volume", - "ocaml_libvirt_job_cancel", - "ocaml_libvirt_job_get_network", - "ocaml_libvirt_job_get_domain", - "ocaml_libvirt_job_get_info", ); #---------------------------------------------------------------------- @@ -235,11 +279,15 @@ sub short_name_to_c_type elsif ($_ eq "net") { "virNetworkPtr" } elsif ($_ eq "pool") { "virStoragePoolPtr" } elsif ($_ eq "vol") { "virStorageVolPtr" } + elsif ($_ eq "job") { "virJobPtr" } else { die "unknown short name $_" } } +# Generate a C signature for the original function. Used when building +# weak bindings. + sub gen_c_signature { my $sig = shift; @@ -281,15 +329,67 @@ sub gen_c_signature } elsif ($sig =~ /^(\w+) : unit$/) { my $c_type = short_name_to_c_type ($1); "int $c_name ($c_type $1)" + } elsif ($sig =~ /^(\w+) : free$/) { + my $c_type = short_name_to_c_type ($1); + "int $c_name ($c_type $1)" + } elsif ($sig =~ /^(\w+), string : unit$/) { + my $c_type = short_name_to_c_type ($1); + "int $c_name ($c_type $1, const char *str)" + } elsif ($sig =~ /^(\w+), string, 0(U?) : unit$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + "int $c_name ($c_type $1, const char *str, $unsigned int flags)" } elsif ($sig =~ /^(\w+), string : (\w+)$/) { my $c_type = short_name_to_c_type ($1); my $c_ret_type = short_name_to_c_type ($2); "$c_ret_type $c_name ($c_type $1, const char *str)" + } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)" + } elsif ($sig =~ /^(\w+), int : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1, int i)" + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1, const unsigned char *str)" + } elsif ($sig =~ /^(\w+), 0(U?) : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1)" + } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1, const char *str)" + } elsif ($sig =~ /^(\w+), string, 0(U?) : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, const char *str, $unsigned int flags)" + } elsif ($sig =~ /^(\w+), 0(U?) : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $unsigned = $2 eq "U" ? "unsigned " : ""; + my $c_ret_type = short_name_to_c_type ($3); + "$c_ret_type $c_name ($c_type $1, $unsigned int flags)" + } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { + my $c_type = short_name_to_c_type ($1); + my $c_ret_type = short_name_to_c_type ($2); + "$c_ret_type $c_name ($c_type $1)" } else { die "unknown signature $sig" } } +# OCaml argument names. + sub gen_arg_names { my $sig = shift; @@ -318,13 +418,39 @@ sub gen_arg_names ( "$1v" ) } elsif ($sig =~ /^(\w+) : unit$/) { ( "$1v" ) + } elsif ($sig =~ /^(\w+) : free$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+), string : unit$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { + ( "$1v", "strv" ) } elsif ($sig =~ /^(\w+), string : (\w+)$/) { ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), int : (\w+)$/) { + ( "$1v", "iv" ) + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + ( "$1v", "uuidv" ) + } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+), string : (\w+) from \w+$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from \w+$/) { + ( "$1v", "strv" ) + } elsif ($sig =~ /^(\w+), 0U? : (\w+) from \w+$/) { + ( "$1v" ) + } elsif ($sig =~ /^(\w+) : (\w+) from \w+$/) { + ( "$1v" ) } else { die "unknown signature $sig" } } +# Unpack the first (object) argument. + sub gen_unpack_args { local $_ = shift; @@ -343,26 +469,47 @@ sub gen_unpack_args } elsif ($_ eq "vol") { "virStorageVolPtr vol = Volume_val (volv);\n". " virConnectPtr conn = Connect_volv (volv);" + } elsif ($_ eq "job") { + "virJobPtr job = Job_val (jobv);\n". + " virConnectPtr conn = Connect_jobv (jobv);" } else { die "unknown short name $_" } } +# Pack the result if it's an object. + sub gen_pack_result { local $_ = shift; - if ($_ eq "dom") { - "rv = Val_domain (r, connv);" - } elsif ($_ eq "net") { - "rv = Val_network (r, connv);" - } elsif ($_ eq "pool") { - "rv = Val_pool (r, connv);" - } elsif ($_ eq "vol") { - "rv = Val_volume (r, connv);" + if ($_ eq "dom") { "rv = Val_domain (r, connv);" } + elsif ($_ eq "net") { "rv = Val_network (r, connv);" } + elsif ($_ eq "pool") { "rv = Val_pool (r, connv);" } + elsif ($_ eq "vol") { "rv = Val_volume (r, connv);" } + elsif ($_ eq "job") { "rv = Val_job (r, connv);" } + else { + die "unknown short name $_" } } +sub gen_free_arg +{ + local $_ = shift; + + if ($_ eq "conn") { "Connect_val (connv) = NULL;" } + elsif ($_ eq "dom") { "Domain_val (domv) = NULL;" } + elsif ($_ eq "net") { "Network_val (netv) = NULL;" } + elsif ($_ eq "pool") { "Pool_val (poolv) = NULL;" } + elsif ($_ eq "vol") { "Volume_val (volv) = NULL;" } + elsif ($_ eq "job") { "Job_val (jobv) = NULL;" } + else { + die "unknown short name $_" + } +} + +# Generate the C body for each signature (class of function). + sub gen_c_code { my $sig = shift; @@ -413,7 +560,9 @@ sub gen_c_code NONBLOCKING (r = $c_name ($1, uuid)); CHECK_ERROR (r == -1, conn, \"$c_name\"); - rv = caml_copy_string ((char *) uuid); + /* UUIDs are byte arrays with a fixed length. */ + rv = caml_alloc_string (VIR_UUID_BUFLEN); + memcpy (String_val (rv), uuid, VIR_UUID_BUFLEN); CAMLreturn (rv); " } elsif ($sig =~ /^(\w+) : uuid string$/) { @@ -500,6 +649,16 @@ sub gen_c_code free (r); CAMLreturn (rv); " + } elsif ($sig =~ /^(\w+), 0U? : unit$/) { + "\ + " . gen_unpack_args ($1) . " + int r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" } elsif ($sig =~ /^(\w+) : unit$/) { "\ " . gen_unpack_args ($1) . " @@ -510,16 +669,43 @@ sub gen_c_code CAMLreturn (Val_unit); " - } elsif ($sig =~ /^(\w+), 0U? : unit$/) { + } elsif ($sig =~ /^(\w+) : free$/) { "\ " . gen_unpack_args ($1) . " int r; - NONBLOCKING (r = $c_name ($1, 0)); + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (r == -1, conn, \"$c_name\"); + + /* So that we don't double-free in the finalizer: */ + " . gen_free_arg ($1) . " + + CAMLreturn (Val_unit); +" + } elsif ($sig =~ /^(\w+), string : unit$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str)); CHECK_ERROR (r == -1, conn, \"$c_name\"); CAMLreturn (Val_unit); " + } elsif ($sig =~ /^(\w+), string, 0U? : unit$/) { + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + int r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + CAMLreturn (Val_unit); +" } elsif ($sig =~ /^(\w+), string : (\w+)$/) { my $c_ret_type = short_name_to_c_type ($2); "\ @@ -535,6 +721,141 @@ sub gen_c_code CAMLreturn (rv); " + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), int : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + int i = Int_val (iv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, i)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), uuid : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + unsigned char *uuid = (unsigned char *) String_val (uuidv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, uuid)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), 0U? : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal1 (rv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), string, 0U? : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + char *str = String_val (strv); + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, str, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+), 0U? : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1, 0)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" + } elsif ($sig =~ /^(\w+) : (\w+) from (\w+)$/) { + my $c_ret_type = short_name_to_c_type ($2); + "\ + CAMLlocal2 (rv, connv); + " . gen_unpack_args ($1) . " + $c_ret_type r; + + NONBLOCKING (r = $c_name ($1)); + CHECK_ERROR (!r, conn, \"$c_name\"); + + connv = Field ($3v, 1); + " . gen_pack_result ($2) . " + + CAMLreturn (rv); +" } else { die "unknown signature $sig" } @@ -563,6 +884,13 @@ foreach my $function (@functions) { die "cannot convert c_name $c_name to c_external_name" } + print F <