diff options
author | 2010-12-10 12:27:33 +0000 | |
---|---|---|
committer | 2011-06-24 11:48:49 +0100 | |
commit | b17b4afafd418cd809dc061581a0d07755cceff1 (patch) | |
tree | 2befe54559e15b5c0acf9c610b20457bf8d0f447 /daemon | |
parent | Introduce generic RPC client objects (diff) | |
download | libvirt-b17b4afafd418cd809dc061581a0d07755cceff1.tar.gz libvirt-b17b4afafd418cd809dc061581a0d07755cceff1.tar.bz2 libvirt-b17b4afafd418cd809dc061581a0d07755cceff1.zip |
Move the RPC generator scripts into src/rpc
Move the daemon/remote_generator.pl to src/rpc/gendispatch.pl
and move the src/remote/rpcgen_fix.pl to src/rpc/genprotocol.pl
* daemon/Makefile.am: Update for new name/location of generator
* src/Makefile.am: Update for new name/location of generator
Diffstat (limited to 'daemon')
-rw-r--r-- | daemon/Makefile.am | 41 | ||||
-rwxr-xr-x | daemon/remote_generator.pl | 1475 |
2 files changed, 20 insertions, 1496 deletions
diff --git a/daemon/Makefile.am b/daemon/Makefile.am index c1b4a9fb9..ad14c901e 100644 --- a/daemon/Makefile.am +++ b/daemon/Makefile.am @@ -28,7 +28,6 @@ AVAHI_SOURCES = \ DISTCLEANFILES = EXTRA_DIST = \ - remote_generator.pl \ remote_dispatch_bodies.h \ qemu_dispatch_bodies.h \ libvirtd.conf \ @@ -56,54 +55,54 @@ BUILT_SOURCES = REMOTE_PROTOCOL = $(top_srcdir)/src/remote/remote_protocol.x QEMU_PROTOCOL = $(top_srcdir)/src/remote/qemu_protocol.x -$(srcdir)/remote_dispatch_prototypes.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/remote_dispatch_prototypes.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(REMOTE_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -c -p remote \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -c -p remote \ $(REMOTE_PROTOCOL) > $@ -$(srcdir)/remote_dispatch_table.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/remote_dispatch_table.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(REMOTE_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -c -t remote \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -c -t remote \ $(REMOTE_PROTOCOL) > $@ -$(srcdir)/remote_dispatch_args.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/remote_dispatch_args.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(REMOTE_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -c -a remote \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -c -a remote \ $(REMOTE_PROTOCOL) > $@ -$(srcdir)/remote_dispatch_ret.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/remote_dispatch_ret.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(REMOTE_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -c -r remote \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -c -r remote \ $(REMOTE_PROTOCOL) > $@ -$(srcdir)/remote_dispatch_bodies.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/remote_dispatch_bodies.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(REMOTE_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -c -b remote \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -c -b remote \ $(REMOTE_PROTOCOL) > $@ -$(srcdir)/qemu_dispatch_prototypes.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/qemu_dispatch_prototypes.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(QEMU_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -p qemu \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -p qemu \ $(QEMU_PROTOCOL) > $@ -$(srcdir)/qemu_dispatch_table.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/qemu_dispatch_table.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(QEMU_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -t qemu \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -t qemu \ $(QEMU_PROTOCOL) > $@ -$(srcdir)/qemu_dispatch_args.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/qemu_dispatch_args.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(QEMU_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -a qemu \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -a qemu \ $(QEMU_PROTOCOL) > $@ -$(srcdir)/qemu_dispatch_ret.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/qemu_dispatch_ret.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(QEMU_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -r qemu \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -r qemu \ $(QEMU_PROTOCOL) > $@ -$(srcdir)/qemu_dispatch_bodies.h: $(srcdir)/remote_generator.pl \ +$(srcdir)/qemu_dispatch_bodies.h: $(srcdir)/../src/rpc/gendispatch.pl \ $(QEMU_PROTOCOL) - $(AM_V_GEN)perl -w $(srcdir)/remote_generator.pl -b qemu \ + $(AM_V_GEN)perl -w $(srcdir)/../src/rpc/gendispatch.pl -b qemu \ $(QEMU_PROTOCOL) > $@ if WITH_LIBVIRTD diff --git a/daemon/remote_generator.pl b/daemon/remote_generator.pl deleted file mode 100755 index 71085d928..000000000 --- a/daemon/remote_generator.pl +++ /dev/null @@ -1,1475 +0,0 @@ -#!/usr/bin/perl -w -# -# This script parses remote_protocol.x or qemu_protocol.x and produces lots of -# boilerplate code for both ends of the remote connection. -# -# The first non-option argument specifies the prefix to be searched for, and -# output to, the boilerplate code. The second non-option argument is the -# file you want to operate on. For instance, to generate the dispatch table -# for both remote_protocol.x and qemu_protocol.x, you would run the -# following: -# -# remote_generator.pl -c -t remote ../src/remote/remote_protocol.x -# remote_generator.pl -t qemu ../src/remote/qemu_protocol.x -# -# By Richard Jones <rjones@redhat.com> -# Extended by Matthias Bolte <matthias.bolte@googlemail.com> - -use strict; - -use Getopt::Std; - -# Command line options. -our ($opt_p, $opt_t, $opt_a, $opt_r, $opt_d, $opt_c, $opt_b, $opt_k); -getopts ('ptardcbk'); - -my $structprefix = shift or die "missing prefix argument"; -my $protocol = shift or die "missing protocol argument"; -my @autogen; - -my $procprefix = uc $structprefix; - -# Convert name_of_call to NameOfCall. -sub name_to_ProcName { - my $name = shift; - my @elems = split /_/, $name; - @elems = map ucfirst, @elems; - @elems = map { $_ =~ s/Nwfilter/NWFilter/; $_ =~ s/Xml/XML/; - $_ =~ s/Uri/URI/; $_ =~ s/Uuid/UUID/; $_ =~ s/Id/ID/; - $_ =~ s/Mac/MAC/; $_ =~ s/Cpu/CPU/; $_ =~ s/Os/OS/; - $_ =~ s/Nmi/NMI/; $_ } @elems; - join "", @elems -} - -# Read the input file (usually remote_protocol.x) and form an -# opinion about the name, args and return type of each RPC. -my ($name, $ProcName, $id, $flags, %calls, @calls); - -# only generate a close method if -c was passed -if ($opt_c) { - # REMOTE_PROC_CLOSE has no args or ret. - $calls{close} = { - name => "close", - ProcName => "Close", - UC_NAME => "CLOSE", - args => "void", - ret => "void", - }; -} - -my $collect_args_members = 0; -my $collect_ret_members = 0; -my $last_name; - -open PROTOCOL, "<$protocol" or die "cannot open $protocol: $!"; - -while (<PROTOCOL>) { - if ($collect_args_members) { - if (/^};/) { - $collect_args_members = 0; - } elsif ($_ =~ m/^\s*(.*\S)\s*$/) { - push(@{$calls{$name}->{args_members}}, $1); - } - } elsif ($collect_ret_members) { - if (/^};/) { - $collect_ret_members = 0; - } elsif ($_ =~ m/^\s*(.*\S)\s*$/) { - push(@{$calls{$name}->{ret_members}}, $1); - } - } elsif (/^struct ${structprefix}_(.*)_args/) { - $name = $1; - $ProcName = name_to_ProcName ($name); - - die "duplicate definition of ${structprefix}_${name}_args" - if exists $calls{$name}; - - $calls{$name} = { - name => $name, - ProcName => $ProcName, - UC_NAME => uc $name, - args => "${structprefix}_${name}_args", - args_members => [], - ret => "void" - }; - - $collect_args_members = 1; - $collect_ret_members = 0; - $last_name = $name; - } elsif (/^struct ${structprefix}_(.*)_ret\s+{(.*)$/) { - $name = $1; - $flags = $2; - $ProcName = name_to_ProcName ($name); - - if (exists $calls{$name}) { - $calls{$name}->{ret} = "${structprefix}_${name}_ret"; - } else { - $calls{$name} = { - name => $name, - ProcName => $ProcName, - UC_NAME => uc $name, - args => "void", - ret => "${structprefix}_${name}_ret", - ret_members => [] - } - } - - if ($flags ne "" and ($opt_b or $opt_k)) { - if (!($flags =~ m/^\s*\/\*\s*insert@(\d+)\s*\*\/\s*$/)) { - die "invalid generator flags for $calls{$name}->{ret}"; - } - - $calls{$name}->{ret_offset} = int($1); - } - - $collect_args_members = 0; - $collect_ret_members = 1; - $last_name = $name; - } elsif (/^struct ${structprefix}_(.*)_msg/) { - $name = $1; - $ProcName = name_to_ProcName ($name); - - $calls{$name} = { - name => $name, - ProcName => $ProcName, - UC_NAME => uc $name, - msg => "${structprefix}_${name}_msg" - }; - - $collect_args_members = 0; - $collect_ret_members = 0; - } elsif (/^\s*${procprefix}_PROC_(.*?)\s*=\s*(\d+)\s*,?(.*)$/) { - $name = lc $1; - $id = $2; - $flags = $3; - $ProcName = name_to_ProcName ($name); - - if ($opt_b or $opt_k) { - if (!($flags =~ m/^\s*\/\*\s*(\S+)\s+(\S+)\s*(.*)\*\/\s*$/)) { - die "invalid generator flags for ${procprefix}_PROC_${name}" - } - - my $genmode = $opt_b ? $1 : $2; - my $genflags = $3; - - if ($genmode eq "autogen") { - push(@autogen, $ProcName); - } elsif ($genmode eq "skipgen") { - # ignore it - } else { - die "invalid generator flags for ${procprefix}_PROC_${name}" - } - - if (defined $genflags and $genflags ne "") { - if ($genflags =~ m/^\|\s*(read|write)stream@(\d+)\s*$/) { - $calls{$name}->{streamflag} = $1; - $calls{$name}->{streamoffset} = int($2); - } else { - die "invalid generator flags for ${procprefix}_PROC_${name}" - } - } else { - $calls{$name}->{streamflag} = "none"; - } - } - - $calls[$id] = $calls{$name}; - - $collect_args_members = 0; - $collect_ret_members = 0; - } else { - $collect_args_members = 0; - $collect_ret_members = 0; - } -} - -close(PROTOCOL); - -# this hash contains the procedures that are allowed to map [unsigned] hyper -# to [unsigned] long for legacy reasons in their signature and return type. -# this list is fixed. new procedures and public APIs have to map [unsigned] -# hyper to [unsigned] long long -my $long_legacy = { - DomainGetMaxMemory => { ret => { memory => 1 } }, - DomainGetInfo => { ret => { maxMem => 1, memory => 1 } }, - DomainMigrate => { arg => { flags => 1, resource => 1 } }, - DomainMigrate2 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateBegin3 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateConfirm3 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateDirect => { arg => { flags => 1, resource => 1 } }, - DomainMigrateFinish => { arg => { flags => 1 } }, - DomainMigrateFinish2 => { arg => { flags => 1 } }, - DomainMigrateFinish3 => { arg => { flags => 1 } }, - DomainMigratePeer2Peer => { arg => { flags => 1, resource => 1 } }, - DomainMigratePerform => { arg => { flags => 1, resource => 1 } }, - DomainMigratePerform3 => { arg => { flags => 1, resource => 1 } }, - DomainMigratePrepare => { arg => { flags => 1, resource => 1 } }, - DomainMigratePrepare2 => { arg => { flags => 1, resource => 1 } }, - DomainMigratePrepare3 => { arg => { flags => 1, resource => 1 } }, - DomainMigratePrepareTunnel => { arg => { flags => 1, resource => 1 } }, - DomainMigratePrepareTunnel3 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateToURI => { arg => { flags => 1, resource => 1 } }, - DomainMigrateToURI2 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateVersion1 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateVersion2 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateVersion3 => { arg => { flags => 1, resource => 1 } }, - DomainMigrateSetMaxSpeed => { arg => { bandwidth => 1 } }, - DomainSetMaxMemory => { arg => { memory => 1 } }, - DomainSetMemory => { arg => { memory => 1 } }, - DomainSetMemoryFlags => { arg => { memory => 1 } }, - GetLibVersion => { ret => { lib_ver => 1 } }, - GetVersion => { ret => { hv_ver => 1 } }, - NodeGetInfo => { ret => { memory => 1 } }, -}; - -sub hyper_to_long -{ - my $proc_name = shift; - my $ret_or_arg = shift; - my $member = shift; - - if ($long_legacy->{$proc_name} and - $long_legacy->{$proc_name}->{$ret_or_arg} and - $long_legacy->{$proc_name}->{$ret_or_arg}->{$member}) { - return 1; - } else { - return 0 - } -} - -#---------------------------------------------------------------------- -# Output - -print <<__EOF__; -/* Automatically generated by remote_generator.pl. - * Do not edit this file. Any changes you make will be lost. - */ -__EOF__ - -if (!$opt_b and !$opt_k) { - print "\n"; -} - -# Debugging. -if ($opt_d) { - my @keys = sort (keys %calls); - foreach (@keys) { - print "$_:\n"; - print " name $calls{$_}->{name} ($calls{$_}->{ProcName})\n"; - print " $calls{$_}->{args} -> $calls{$_}->{ret}\n"; - } -} - -# Prototypes for dispatch functions ("remote_dispatch_prototypes.h"). -elsif ($opt_p) { - my @keys = sort (keys %calls); - foreach (@keys) { - # Skip things which are REMOTE_MESSAGE - next if $calls{$_}->{msg}; - - print "static int ${structprefix}Dispatch$calls{$_}->{ProcName}(\n"; - print " struct qemud_server *server,\n"; - print " struct qemud_client *client,\n"; - print " virConnectPtr conn,\n"; - print " remote_message_header *hdr,\n"; - print " remote_error *rerr,\n"; - print " $calls{$_}->{args} *args,\n"; - print " $calls{$_}->{ret} *ret);\n"; - } -} - -# Union of all arg types -# ("remote_dispatch_args.h"). -elsif ($opt_a) { - for ($id = 0 ; $id <= $#calls ; $id++) { - if (defined $calls[$id] && - !$calls[$id]->{msg} && - $calls[$id]->{args} ne "void") { - print " $calls[$id]->{args} val_$calls[$id]->{args};\n"; - } - } -} - -# Union of all arg types -# ("remote_dispatch_ret.h"). -elsif ($opt_r) { - for ($id = 0 ; $id <= $#calls ; $id++) { - if (defined $calls[$id] && - !$calls[$id]->{msg} && - $calls[$id]->{ret} ne "void") { - print " $calls[$id]->{ret} val_$calls[$id]->{ret};\n"; - } - } -} - -# Inside the switch statement, prepare the 'fn', 'args_filter', etc -# ("remote_dispatch_table.h"). -elsif ($opt_t) { - for ($id = 0 ; $id <= $#calls ; $id++) { - if (defined $calls[$id] && !$calls[$id]->{msg}) { - print "{ /* $calls[$id]->{ProcName} => $id */\n"; - print " .fn = (dispatch_fn) ${structprefix}Dispatch$calls[$id]->{ProcName},\n"; - if ($calls[$id]->{args} ne "void") { - print " .args_filter = (xdrproc_t) xdr_$calls[$id]->{args},\n"; - } else { - print " .args_filter = (xdrproc_t) xdr_void,\n"; - } - if ($calls[$id]->{ret} ne "void") { - print " .ret_filter = (xdrproc_t) xdr_$calls[$id]->{ret},\n"; - } else { - print " .ret_filter = (xdrproc_t) xdr_void,\n"; - } - print "},\n"; - } else { - if ($calls[$id]->{msg}) { - print "{ /* Async event $calls[$id]->{ProcName} => $id */\n"; - } else { - print "{ /* (unused) => $id */\n"; - } - print " .fn = NULL,\n"; - print " .args_filter = (xdrproc_t) xdr_void,\n"; - print " .ret_filter = (xdrproc_t) xdr_void,\n"; - print "},\n"; - } - } -} - -# Bodies for dispatch functions ("remote_dispatch_bodies.h"). -elsif ($opt_b) { - my %generate = map { $_ => 1 } @autogen; - my @keys = sort (keys %calls); - - foreach (@keys) { - my $call = $calls{$_}; - - # skip things which are REMOTE_MESSAGE - next if $call->{msg}; - - # skip procedures not on generate list - next if ! exists($generate{$call->{ProcName}}); - - my $has_node_device = 0; - my @vars_list = (); - my @optionals_list = (); - my @getters_list = (); - my @args_list = (); - my @prepare_ret_list = (); - my @ret_list = (); - my @free_list = (); - my @free_list_on_error = ("remoteDispatchError(rerr);"); - - # handle arguments to the function - if ($call->{args} ne "void") { - # node device is special, as it's identified by name - if ($call->{args} =~ m/^remote_node_device_/ and - !($call->{args} =~ m/^remote_node_device_lookup_by_name_/) and - !($call->{args} =~ m/^remote_node_device_create_xml_/)) { - $has_node_device = 1; - push(@vars_list, "virNodeDevicePtr dev = NULL"); - push(@getters_list, - " if (!(dev = virNodeDeviceLookupByName(conn, args->name)))\n" . - " goto cleanup;\n"); - push(@args_list, "dev"); - push(@free_list, - " if (dev)\n" . - " virNodeDeviceFree(dev);"); - } - - foreach my $args_member (@{$call->{args_members}}) { - if ($args_member =~ m/^remote_nonnull_string name;/ and $has_node_device) { - # ignore the name arg for node devices - next - } elsif ($args_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|interface|secret|nwfilter) (\S+);/) { - my $type_name = name_to_ProcName($1); - - push(@vars_list, "vir${type_name}Ptr $2 = NULL"); - push(@getters_list, - " if (!($2 = get_nonnull_$1(conn, args->$2)))\n" . - " goto cleanup;\n"); - push(@args_list, "$2"); - push(@free_list, - " if ($2)\n" . - " vir${type_name}Free($2);"); - } elsif ($args_member =~ m/^remote_nonnull_domain_snapshot /) { - push(@vars_list, "virDomainPtr dom = NULL"); - push(@vars_list, "virDomainSnapshotPtr snapshot = NULL"); - push(@getters_list, - " if (!(dom = get_nonnull_domain(conn, args->snap.dom)))\n" . - " goto cleanup;\n" . - "\n" . - " if (!(snapshot = get_nonnull_domain_snapshot(dom, args->snap)))\n" . - " goto cleanup;\n"); - push(@args_list, "snapshot"); - push(@free_list, - " if (snapshot)\n" . - " virDomainSnapshotFree(snapshot);\n" . - " if (dom)\n" . - " virDomainFree(dom);"); - } elsif ($args_member =~ m/^(?:remote_string|remote_uuid) (\S+)<\S+>;/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - push(@args_list, "args->$1.$1_val"); - push(@args_list, "args->$1.$1_len"); - } elsif ($args_member =~ m/^(?:opaque|remote_nonnull_string) (\S+)<\S+>;(.*)$/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - my $cast = ""; - my $arg_name = $1; - my $annotation = $2; - - if ($annotation ne "") { - if ($annotation =~ m/\s*\/\*\s*(.*)\s*\*\//) { - $cast = $1; - } else { - die "malformed cast annotation for argument: $args_member"; - } - } - - push(@args_list, "${cast}args->$arg_name.${arg_name}_val"); - push(@args_list, "args->$arg_name.${arg_name}_len"); - } elsif ($args_member =~ m/^(?:unsigned )?int (\S+)<\S+>;/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - push(@args_list, "args->$1.$1_val"); - push(@args_list, "args->$1.$1_len"); - } elsif ($args_member =~ m/^remote_typed_param (\S+)<(\S+)>;/) { - push(@vars_list, "virTypedParameterPtr $1 = NULL"); - push(@vars_list, "int n$1"); - push(@args_list, "$1"); - push(@args_list, "n$1"); - push(@getters_list, " if (($1 = remoteDeserializeTypedParameters(args->$1.$1_val,\n" . - " args->$1.$1_len,\n" . - " $2,\n" . - " &n$1)) == NULL)\n" . - " goto cleanup;\n"); - push(@free_list, " VIR_FREE(params);"); - } elsif ($args_member =~ m/<\S+>;/ or $args_member =~ m/\[\S+\];/) { - # just make all other array types fail - die "unhandled type for argument value: $args_member"; - } elsif ($args_member =~ m/^remote_uuid (\S+);/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - push(@args_list, "(unsigned char *) args->$1"); - } elsif ($args_member =~ m/^remote_string (\S+);/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - push(@vars_list, "char *$1"); - push(@optionals_list, "$1"); - push(@args_list, "$1"); - } elsif ($args_member =~ m/^remote_nonnull_string (\S+);/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - push(@args_list, "args->$1"); - } elsif ($args_member =~ m/^(unsigned )?int (\S+);/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - push(@args_list, "args->$2"); - } elsif ($args_member =~ m/^(unsigned )?hyper (\S+);/) { - if (! @args_list) { - push(@args_list, "conn"); - } - - my $arg_name = $2; - - if (hyper_to_long($call->{ProcName}, "arg", $arg_name)) { - my $type_name = $1; $type_name .= "long"; - my $sign = ""; $sign = "U" if ($1); - - push(@vars_list, "$type_name $arg_name"); - push(@getters_list, " HYPER_TO_${sign}LONG($arg_name, args->$arg_name);\n"); - push(@args_list, "$arg_name"); - } else { - push(@args_list, "args->$arg_name"); - } - } elsif ($args_member =~ m/^(\/)?\*/) { - # ignore comments - } else { - die "unhandled type for argument value: $args_member"; - } - } - } - - # handle return values of the function - my $single_ret_var = "undefined"; - my $single_ret_by_ref = 0; - my $single_ret_check = " == undefined"; - my $single_ret_as_list = 0; - my $single_ret_list_name = "undefined"; - my $single_ret_list_max_var = "undefined"; - my $single_ret_list_max_define = "undefined"; - my $multi_ret = 0; - - if ($call->{ret} ne "void" and - scalar(@{$call->{ret_members}}) > 1) { - $multi_ret = 1; - } - - if ($call->{ret} ne "void") { - foreach my $ret_member (@{$call->{ret_members}}) { - if ($multi_ret) { - if ($ret_member =~ m/^(unsigned )?(char|short|int|hyper) (\S+)\[\S+\];/) { - if ($2 eq "hyper" and hyper_to_long($call->{ProcName}, "ret", $3)) { - die "legacy [u]long hyper arrays aren't supported"; - } - - push(@ret_list, "memcpy(ret->$3, tmp.$3, sizeof ret->$3);"); - } elsif ($ret_member =~ m/^(unsigned )?(char|short|int|hyper) (\S+);/) { - push(@ret_list, "ret->$3 = tmp.$3;"); - } else { - die "unhandled type for multi-return-value: $ret_member"; - } - } elsif ($ret_member =~ m/^remote_nonnull_string (\S+)<(\S+)>;\s*\/\*\s*insert@(\d+)\s*\*\//) { - push(@vars_list, "int len"); - splice(@args_list, int($3), 0, ("ret->$1.$1_val")); - push(@ret_list, "ret->$1.$1_len = len;"); - push(@free_list_on_error, "VIR_FREE(ret->$1.$1_val);"); - $single_ret_var = "len"; - $single_ret_by_ref = 0; - $single_ret_check = " < 0"; - $single_ret_as_list = 1; - $single_ret_list_name = $1; - $single_ret_list_max_var = "max$1"; - $single_ret_list_max_define = $2; - } elsif ($ret_member =~ m/^remote_nonnull_string (\S+)<\S+>;/) { - # error out on unannotated arrays - die "remote_nonnull_string array without insert@<offset> annotation: $ret_member"; - } elsif ($ret_member =~ m/^remote_nonnull_string (\S+);/) { - if ($call->{ProcName} eq "GetType") { - # SPECIAL: virConnectGetType returns a constant string that must - # not be freed. Therefore, duplicate the string here. - push(@vars_list, "const char *$1"); - push(@ret_list, "/* We have to strdup because remoteDispatchClientRequest will"); - push(@ret_list, " * free this string after it's been serialised. */"); - push(@ret_list, "if (!(ret->type = strdup(type))) {"); - push(@ret_list, " virReportOOMError();"); - push(@ret_list, " goto cleanup;"); - push(@ret_list, "}"); - } else { - push(@vars_list, "char *$1"); - push(@ret_list, "ret->$1 = $1;"); - } - - $single_ret_var = $1; - $single_ret_by_ref = 0; - $single_ret_check = " == NULL"; - } elsif ($ret_member =~ m/^remote_string (\S+);/) { - push(@vars_list, "char *$1 = NULL"); - push(@vars_list, "char **$1_p = NULL"); - push(@ret_list, "ret->$1 = $1_p;"); - push(@free_list, " VIR_FREE($1);"); - push(@free_list_on_error, "VIR_FREE($1_p);"); - push(@prepare_ret_list, - "if (VIR_ALLOC($1_p) < 0) {\n" . - " virReportOOMError();\n" . - " goto cleanup;\n" . - " }\n" . - " \n" . - " *$1_p = strdup($1);\n" . - " if (*$1_p == NULL) {\n" . - " virReportOOMError();\n" . - " goto cleanup;\n" . - " }\n"); - - $single_ret_var = $1; - $single_ret_by_ref = 0; - $single_ret_check = " == NULL"; - } elsif ($ret_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|interface|node_device|secret|nwfilter|domain_snapshot) (\S+);/) { - my $type_name = name_to_ProcName($1); - - if ($call->{ProcName} eq "DomainCreateWithFlags") { - # SPECIAL: virDomainCreateWithFlags updates the given - # domain object instead of returning a new one - push(@ret_list, "make_nonnull_$1(&ret->$2, $2);"); - $single_ret_var = undef; - $single_ret_by_ref = 1; - } else { - push(@vars_list, "vir${type_name}Ptr $2 = NULL"); - push(@ret_list, "make_nonnull_$1(&ret->$2, $2);"); - push(@free_list, - " if ($2)\n" . - " vir${type_name}Free($2);"); - $single_ret_var = $2; - $single_ret_by_ref = 0; - $single_ret_check = " == NULL"; - } - } elsif ($ret_member =~ m/^int (\S+)<(\S+)>;\s*\/\*\s*insert@(\d+)\s*\*\//) { - push(@vars_list, "int len"); - splice(@args_list, int($3), 0, ("ret->$1.$1_val")); - push(@ret_list, "ret->$1.$1_len = len;"); - push(@free_list_on_error, "VIR_FREE(ret->$1.$1_val);"); - $single_ret_var = "len"; - $single_ret_by_ref = 0; - $single_ret_check = " < 0"; - $single_ret_as_list = 1; - $single_ret_list_name = $1; - $single_ret_list_max_var = "max$1"; - $single_ret_list_max_define = $2; - } elsif ($ret_member =~ m/^int (\S+)<\S+>;/) { - # error out on unannotated arrays - die "int array without insert@<offset> annotation: $ret_member"; - } elsif ($ret_member =~ m/^int (\S+);/) { - push(@vars_list, "int $1"); - push(@ret_list, "ret->$1 = $1;"); - $single_ret_var = $1; - - if ($call->{ProcName} =~ m/GetAutostart$/) { - $single_ret_by_ref = 1; - } else { - $single_ret_by_ref = 0; - - if ($call->{ProcName} eq "CPUCompare") { - $single_ret_check = " == VIR_CPU_COMPARE_ERROR"; - } else { - $single_ret_check = " < 0"; - } - } - } elsif ($ret_member =~ m/^(?:unsigned )?hyper (\S+)<(\S+)>;\s*\/\*\s*insert@(\d+)\s*\*\//) { - if (hyper_to_long($call->{ProcName}, "ret", $1)) { - die "legacy [u]long hyper arrays aren't supported"; - } - - push(@vars_list, "int len"); - push(@ret_list, "ret->$1.$1_len = len;"); - push(@free_list_on_error, "VIR_FREE(ret->$1.$1_val);"); - $single_ret_var = "len"; - $single_ret_by_ref = 0; - $single_ret_as_list = 1; - $single_ret_list_name = $1; - $single_ret_list_max_var = "max$1"; - $single_ret_list_max_define = $2; - - if ($call->{ProcName} eq "NodeGetCellsFreeMemory") { - $single_ret_check = " <= 0"; - splice(@args_list, int($3), 0, ("(unsigned long long *)ret->$1.$1_val")); - } else { - $single_ret_check = " < 0"; - splice(@args_list, int($3), 0, ("ret->$1.$1_val")); - } - } elsif ($ret_member =~ m/^(?:unsigned )?hyper (\S+)<\S+>;/) { - # error out on unannotated arrays - die "hyper array without insert@<offset> annotation: $ret_member"; - } elsif ($ret_member =~ m/^(unsigned )?hyper (\S+);/) { - my $type_name = $1; - my $ret_name = $2; - my $ret_assign; - - if (hyper_to_long($call->{ProcName}, "ret", $ret_name)) { - my $sign = ""; $sign = "U" if ($1); - - $type_name .= "long"; - $ret_assign = "HYPER_TO_${sign}LONG(ret->$ret_name, $ret_name);"; - } else { - $type_name .= "long long"; - $ret_assign = "ret->$ret_name = $ret_name;"; - } - - push(@vars_list, "$type_name $ret_name"); - push(@ret_list, $ret_assign); - $single_ret_var = $ret_name; - - if ($call->{ProcName} eq "DomainGetMaxMemory" or - $call->{ProcName} eq "NodeGetFreeMemory") { - # SPECIAL: virDomainGetMaxMemory and virNodeGetFreeMemory - # return the actual value directly and 0 indicates - # an error - $single_ret_by_ref = 0; - $single_ret_check = " == 0"; - } else { - $single_ret_by_ref = 1; - } - } elsif ($ret_member =~ m/^opaque (\S+)<(\S+)>;\s*\/\*\s*insert@(\d+)\s*\*\//) { - push(@vars_list, "char *$1 = NULL"); - push(@vars_list, "int $1_len = 0"); - splice(@args_list, int($3), 0, ("&$1", "&$1_len")); - push(@ret_list, "ret->$1.$1_val = $1;"); - push(@ret_list, "ret->$1.$1_len = $1_len;"); - push(@free_list_on_error, "VIR_FREE($1);"); - $single_ret_var = undef; - $single_ret_by_ref = 1; - } elsif ($ret_member =~ m/^opaque (\S+)<\S+>;/) { - # error out on unannotated arrays - die "opaque array without insert@<offset> annotation: $ret_member"; - } elsif ($ret_member =~ m/^(\/)?\*/) { - # ignore comments - } else { - die "unhandled type for return value: $ret_member"; - } - } - } - - # select struct type for multi-return-value functions - if ($multi_ret) { - if (!(defined $call->{ret_offset})) { - die "multi-return-value without insert@<offset> annotation: $call->{ret}"; - } - - if (!@args_list) { - push(@args_list, "conn"); - } - - my $struct_name = $call->{ProcName}; - $struct_name =~ s/Get//; - - splice(@args_list, $call->{ret_offset}, 0, ("&tmp")); - - if ($call->{ProcName} eq "DomainBlockStats" || - $call->{ProcName} eq "DomainInterfaceStats") { - # SPECIAL: virDomainBlockStats and virDomainInterfaceStats - # have a 'Struct' suffix on the actual struct name - # and take the struct size as additional argument - $struct_name .= "Struct"; - splice(@args_list, $call->{ret_offset} + 1, 0, ("sizeof tmp")); - } - - push(@vars_list, "vir$struct_name tmp"); - } - - if ($call->{streamflag} ne "none") { - splice(@args_list, $call->{streamoffset}, 0, ("stream->st")); - push(@free_list_on_error, "if (stream) {"); - push(@free_list_on_error, " virStreamAbort(stream->st);"); - push(@free_list_on_error, " remoteFreeClientStream(client, stream);"); - push(@free_list_on_error, "}"); - } - - # print functions signature - print "\n"; - print "static int\n"; - print "${structprefix}Dispatch$call->{ProcName}(\n"; - print " struct qemud_server *server ATTRIBUTE_UNUSED,\n"; - print " struct qemud_client *client ATTRIBUTE_UNUSED,\n"; - print " virConnectPtr conn,\n"; - print " remote_message_header *hdr ATTRIBUTE_UNUSED,\n"; - print " remote_error *rerr,\n"; - print " $call->{args} *args"; - - if ($call->{args} eq "void") { - print " ATTRIBUTE_UNUSED" - } - - print ",\n"; - print " $call->{ret} *ret"; - - if ($call->{ret} eq "void") { - print " ATTRIBUTE_UNUSED" - } - - print ")\n"; - - # print function body - print "{\n"; - print " int rv = -1;\n"; - - foreach my $var (@vars_list) { - print " $var;\n"; - } - - if ($call->{streamflag} ne "none") { - print " struct qemud_client_stream *stream = NULL;\n"; - } - - print "\n"; - print " if (!conn) {\n"; - print " virNetError(VIR_ERR_INTERNAL_ERROR, \"%s\", _(\"connection not open\"));\n"; - print " goto cleanup;\n"; - print " }\n"; - print "\n"; - - if ($single_ret_as_list) { - print " if (args->$single_ret_list_max_var > $single_ret_list_max_define) {\n"; - print " virNetError(VIR_ERR_INTERNAL_ERROR,\n"; - print " \"%s\", _(\"max$single_ret_list_name > $single_ret_list_max_define\"));\n"; - print " goto cleanup;\n"; - print " }\n"; - print "\n"; - } - - print join("\n", @getters_list); - - if (@getters_list) { - print "\n"; - } - - foreach my $optional (@optionals_list) { - print " $optional = args->$optional ? *args->$optional : NULL;\n"; - } - - if (@optionals_list) { - print "\n"; - } - - if ($call->{streamflag} ne "none") { - print " if (!(stream = remoteCreateClientStream(conn, hdr)))\n"; - print " goto cleanup;\n"; - print "\n"; - } - - if ($call->{ret} eq "void") { - print " if (vir$call->{ProcName}("; - print join(', ', @args_list); - print ") < 0)\n"; - print " goto cleanup;\n"; - print "\n"; - } elsif (!$multi_ret) { - my $prefix = ""; - my $proc_name = $call->{ProcName}; - - if (! @args_list) { - push(@args_list, "conn"); - - if ($call->{ProcName} ne "NodeGetFreeMemory") { - $prefix = "Connect" - } - } - - if ($call->{ProcName} eq "GetSysinfo" or - $call->{ProcName} eq "GetMaxVcpus" or - $call->{ProcName} eq "DomainXMLFromNative" or - $call->{ProcName} eq "DomainXMLToNative" or - $call->{ProcName} eq "FindStoragePoolSources" or - $call->{ProcName} =~ m/^List/) { - $prefix = "Connect" - } elsif ($call->{ProcName} eq "SupportsFeature") { - $prefix = "Drv" - } elsif ($call->{ProcName} eq "CPUBaseline") { - $proc_name = "ConnectBaselineCPU" - } elsif ($call->{ProcName} eq "CPUCompare") { - $proc_name = "ConnectCompareCPU" - } - - if ($single_ret_as_list) { - print " /* Allocate return buffer. */\n"; - print " if (VIR_ALLOC_N(ret->$single_ret_list_name.${single_ret_list_name}_val," . - " args->$single_ret_list_max_var) < 0) {\n"; - print " virReportOOMError();\n"; - print " goto cleanup;\n"; - print " }\n"; - print "\n"; - } - - if ($single_ret_by_ref) { - print " if (vir$prefix$proc_name("; - print join(', ', @args_list); - - if (defined $single_ret_var) { - print ", &$single_ret_var"; - } - - print ") < 0)\n"; - } else { - print " if (($single_ret_var = vir$prefix$proc_name("; - print join(', ', @args_list); - print "))$single_ret_check)\n"; - } - - print " goto cleanup;\n"; - print "\n"; - } else { - print " if (vir$call->{ProcName}("; - print join(', ', @args_list); - print ") < 0)\n"; - print " goto cleanup;\n"; - print "\n"; - } - - if ($call->{streamflag} ne "none") { - print " if (remoteAddClientStream(client, stream, "; - - if ($call->{streamflag} eq "write") { - print "0"; - } else { - print "1"; - } - - print ") < 0)\n"; - print " goto cleanup;\n"; - print "\n"; - } - - if (@prepare_ret_list) { - print " "; - print join("\n ", @prepare_ret_list); - print "\n"; - } - - if (@ret_list) { - print " "; - print join("\n ", @ret_list); - print "\n"; - } - - print " rv = 0;\n"; - print "\n"; - print "cleanup:\n"; - print " if (rv < 0)"; - - if (scalar(@free_list_on_error) > 1) { - print " {"; - } - - print "\n "; - print join("\n ", @free_list_on_error); - print "\n"; - - if (scalar(@free_list_on_error) > 1) { - print " }\n"; - } - - print join("\n", @free_list); - - if (@free_list) { - print "\n"; - } - - print " return rv;\n"; - print "}\n"; - } -} - -# Bodies for client functions ("remote_client_bodies.h"). -elsif ($opt_k) { - my %generate = map { $_ => 1 } @autogen; - my @keys = sort (keys %calls); - - foreach (@keys) { - my $call = $calls{$_}; - - # skip things which are REMOTE_MESSAGE - next if $call->{msg}; - - # skip procedures not on generate list - next if ! exists($generate{$call->{ProcName}}); - - # handle arguments to the function - my @args_list = (); - my @vars_list = (); - my @args_check_list = (); - my @setters_list = (); - my @setters_list2 = (); - my $priv_src = "conn"; - my $priv_name = "privateData"; - my $call_args = "&args"; - - if ($call->{args} eq "void") { - $call_args = "NULL"; - } else { - push(@vars_list, "$call->{args} args"); - - my $is_first_arg = 1; - my $has_node_device = 0; - - # node device is special - if ($call->{args} =~ m/^remote_node_/ and - !($call->{args} =~ m/^remote_node_device_lookup_by_name_/) and - !($call->{args} =~ m/^remote_node_device_create_xml_/)) { - $has_node_device = 1; - $priv_name = "devMonPrivateData"; - } - - foreach my $args_member (@{$call->{args_members}}) { - if ($args_member =~ m/^remote_nonnull_string name;/ and $has_node_device) { - $priv_src = "dev->conn"; - push(@args_list, "virNodeDevicePtr dev"); - push(@setters_list, "args.name = dev->name;"); - } elsif ($args_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|interface|secret|nwfilter|domain_snapshot) (\S+);/) { - my $name = $1; - my $arg_name = $2; - my $type_name = name_to_ProcName($name); - - if ($is_first_arg) { - if ($name eq "domain_snapshot") { - $priv_src = "$arg_name->domain->conn"; - } else { - $priv_src = "$arg_name->conn"; - } - - if ($name =~ m/^storage_/) { - $priv_name = "storagePrivateData"; - } elsif (!($name =~ m/^domain/)) { - $priv_name = "${name}PrivateData"; - } - } - - push(@args_list, "vir${type_name}Ptr $arg_name"); - push(@setters_list, "make_nonnull_$1(&args.$arg_name, $arg_name);"); - } elsif ($args_member =~ m/^remote_uuid (\S+);/) { - push(@args_list, "const unsigned char *$1"); - push(@setters_list, "memcpy(args.$1, $1, VIR_UUID_BUFLEN);"); - } elsif ($args_member =~ m/^remote_string (\S+);/) { - push(@args_list, "const char *$1"); - push(@setters_list, "args.$1 = $1 ? (char **)&$1 : NULL;"); - } elsif ($args_member =~ m/^remote_nonnull_string (\S+)<(\S+)>;(.*)$/) { - my $type_name = "const char **"; - my $arg_name = $1; - my $limit = $2; - my $annotation = $3; - - if ($annotation ne "") { - if ($annotation =~ m/\s*\/\*\s*\((.*)\)\s*\*\//) { - $type_name = $1; - } else { - die "malformed cast annotation for argument: $args_member"; - } - } - - push(@args_list, "$type_name$arg_name"); - push(@args_list, "unsigned int ${arg_name}len"); - push(@setters_list, "args.$arg_name.${arg_name}_val = (char **)$arg_name;"); - push(@setters_list, "args.$arg_name.${arg_name}_len = ${arg_name}len;"); - push(@args_check_list, { name => "\"$arg_name\"", arg => "${arg_name}len", limit => $2 }); - } elsif ($args_member =~ m/^remote_nonnull_string (\S+);/) { - push(@args_list, "const char *$1"); - push(@setters_list, "args.$1 = (char *)$1;"); - } elsif ($args_member =~ m/^opaque (\S+)<(\S+)>;(.*)$/) { - my $type_name = "const char *"; - my $arg_name = $1; - my $limit = $2; - my $annotation = $3; - - if ($annotation ne "") { - if ($annotation =~ m/\s*\/\*\s*\((.*)\)\s*\*\//) { - $type_name = $1; - } else { - die "malformed cast annotation for argument: $args_member"; - } - } - - push(@args_list, "$type_name$arg_name"); - - if ($call->{ProcName} eq "SecretSetValue") { - # SPECIAL: virSecretSetValue uses size_t instead of int - push(@args_list, "size_t ${arg_name}len"); - } else { - push(@args_list, "int ${arg_name}len"); - } - - push(@setters_list, "args.$arg_name.${arg_name}_val = (char *)$arg_name;"); - push(@setters_list, "args.$arg_name.${arg_name}_len = ${arg_name}len;"); - push(@args_check_list, { name => "\"$arg_name\"", arg => "${arg_name}len", limit => $limit }); - } elsif ($args_member =~ m/^remote_string (\S+)<(\S+)>;/) { - my $arg_name = $1; - my $limit = $2; - - push(@args_list, "const char *$arg_name"); - push(@args_list, "int ${arg_name}len"); - push(@setters_list, "args.$arg_name.${arg_name}_val = (char *)$arg_name;"); - push(@setters_list, "args.$arg_name.${arg_name}_len = ${arg_name}len;"); - push(@args_check_list, { name => "\"$arg_name\"", arg => "${arg_name}len", limit => $limit }); - } elsif ($args_member =~ m/^((?:unsigned )?int) (\S+)<(\S+)>;/) { - my $type_name = $1; - my $arg_name = $2; - my $limit = $3; - - push(@args_list, "${type_name} *$arg_name"); - push(@args_list, "int ${arg_name}len"); - push(@setters_list, "args.$arg_name.${arg_name}_val = $arg_name;"); - push(@setters_list, "args.$arg_name.${arg_name}_len = ${arg_name}len;"); - push(@args_check_list, { name => "\"$arg_name\"", arg => "${arg_name}len", limit => $limit }); - } elsif ($args_member =~ m/^remote_typed_param (\S+)<(\S+)>;/) { - push(@args_list, "virTypedParameterPtr $1"); - push(@args_list, "int n$1"); - push(@setters_list2, "if (remoteSerializeTypedParameters($1, n$1, &args.$1.$1_val, &args.$1.$1_len) < 0) {\n" . - " xdr_free((xdrproc_t)xdr_$call->{args}, (char *)&args);\n" . - " goto done;\n" . - " }"); - } elsif ($args_member =~ m/^((?:unsigned )?int) (\S+);\s*\/\*\s*call-by-reference\s*\*\//) { - my $type_name = "$1 *"; - my $arg_name = $2; - - push(@args_list, "$type_name $arg_name"); - push(@setters_list, "args.$arg_name = *$arg_name;"); - } elsif ($args_member =~ m/^((?:unsigned )?int) (\S+);/) { - my $type_name = $1; - my $arg_name = $2; - - push(@args_list, "$type_name $arg_name"); - push(@setters_list, "args.$arg_name = $arg_name;"); - } elsif ($args_member =~ m/^(unsigned )?hyper (\S+);/) { - my $type_name = $1; - my $arg_name = $2; - - if (hyper_to_long($call->{ProcName}, "arg", $arg_name)) { - $type_name .= "long"; - } else { - $type_name .= "long long"; - } - - push(@args_list, "$type_name $arg_name"); - push(@setters_list, "args.$arg_name = $arg_name;"); - } elsif ($args_member =~ m/^(\/)?\*/) { - # ignore comments - } else { - die "unhandled type for argument value: $args_member"; - } - - if ($is_first_arg and $priv_src eq "conn") { - unshift(@args_list, "virConnectPtr conn"); - } - - $is_first_arg = 0; - } - } - - if (! @args_list) { - push(@args_list, "virConnectPtr conn"); - } - - # fix priv_name for the NumOf* functions - if ($priv_name eq "privateData" and - !($call->{ProcName} =~ m/(Domains|DomainSnapshot)/) and - ($call->{ProcName} =~ m/NumOf(Defined|Domain)*(\S+)s/ or - $call->{ProcName} =~ m/List(Defined|Domain)*(\S+)s/)) { - my $prefix = lc $2; - $prefix =~ s/(pool|vol)$//; - $priv_name = "${prefix}PrivateData"; - } - - # handle return values of the function - my @ret_list = (); - my @ret_list2 = (); - my $call_ret = "&ret"; - my $single_ret_var = "int rv = -1"; - my $single_ret_type = "int"; - my $single_ret_as_list = 0; - my $single_ret_list_error_msg_type = "undefined"; - my $single_ret_list_name = "undefined"; - my $single_ret_list_max_var = "undefined"; - my $single_ret_list_max_define = "undefined"; - my $single_ret_cleanup = 0; - my $multi_ret = 0; - - if ($call->{ret} ne "void" and - scalar(@{$call->{ret_members}}) > 1) { - $multi_ret = 1; - } - - if ($call->{ret} eq "void") { - $call_ret = "NULL"; - } else { - push(@vars_list, "$call->{ret} ret"); - - foreach my $ret_member (@{$call->{ret_members}}) { - if ($multi_ret) { - if ($ret_member =~ m/^(unsigned )?(char|short|int|hyper) (\S+)\[\S+\];/) { - if ($2 eq "hyper" and hyper_to_long($call->{ProcName}, "ret", $3)) { - die "legacy [u]long hyper arrays aren't supported"; - } - - push(@ret_list, "memcpy(result->$3, ret.$3, sizeof result->$3);"); - } elsif ($ret_member =~ m/<\S+>;/ or $ret_member =~ m/\[\S+\];/) { - # just make all other array types fail - die "unhandled type for multi-return-value for " . - "procedure $call->{name}: $ret_member"; - } elsif ($ret_member =~ m/^(unsigned )?(char|short|int|hyper) (\S+);/) { - if ($2 eq "hyper" and hyper_to_long($call->{ProcName}, "ret", $3)) { - my $sign = ""; $sign = "U" if ($1); - - push(@ret_list, "HYPER_TO_${sign}LONG(result->$3, ret.$3);"); - } else { - push(@ret_list, "result->$3 = ret.$3;"); - } - } else { - die "unhandled type for multi-return-value for " . - "procedure $call->{name}: $ret_member"; - } - } elsif ($ret_member =~ m/^remote_nonnull_string (\S+)<(\S+)>;\s*\/\*\s*insert@(\d+)\s*\*\//) { - splice(@args_list, int($3), 0, ("char **const $1")); - push(@ret_list, "rv = ret.$1.$1_len;"); - $single_ret_var = "int rv = -1"; - $single_ret_type = "int"; - $single_ret_as_list = 1; - $single_ret_list_name = $1; - $single_ret_list_max_var = "max$1"; - $single_ret_list_max_define = $2; - } elsif ($ret_member =~ m/^remote_nonnull_string (\S+)<\S+>;/) { - # error out on unannotated arrays - die "remote_nonnull_string array without insert@<offset> annotation: $ret_member"; - } elsif ($ret_member =~ m/^remote_nonnull_string (\S+);/) { - push(@ret_list, "rv = ret.$1;"); - $single_ret_var = "char *rv = NULL"; - $single_ret_type = "char *"; - } elsif ($ret_member =~ m/^remote_string (\S+);/) { - push(@ret_list, "rv = ret.$1 ? *ret.$1 : NULL;"); - push(@ret_list, "VIR_FREE(ret.$1);"); - $single_ret_var = "char *rv = NULL"; - $single_ret_type = "char *"; - } elsif ($ret_member =~ m/^remote_nonnull_(domain|network|storage_pool|storage_vol|node_device|interface|secret|nwfilter|domain_snapshot) (\S+);/) { - my $name = $1; - my $arg_name = $2; - my $type_name = name_to_ProcName($name); - - if ($name eq "node_device") { - $priv_name = "devMonPrivateData"; - } elsif ($name =~ m/^storage_/) { - $priv_name = "storagePrivateData"; - } elsif (!($name =~ m/^domain/)) { - $priv_name = "${name}PrivateData"; - } - - if ($call->{ProcName} eq "DomainCreateWithFlags") { - # SPECIAL: virDomainCreateWithFlags updates the given - # domain object instead of returning a new one - push(@ret_list, "dom->id = ret.dom.id;"); - push(@ret_list, "xdr_free((xdrproc_t)xdr_$call->{ret}, (char *)&ret);"); - push(@ret_list, "rv = 0;"); - $single_ret_var = "int rv = -1"; - $single_ret_type = "int"; - } else { - if ($name eq "domain_snapshot") { - push(@ret_list, "rv = get_nonnull_$name(dom, ret.$arg_name);"); - } else { - push(@ret_list, "rv = get_nonnull_$name($priv_src, ret.$arg_name);"); - } - - push(@ret_list, "xdr_free((xdrproc_t)xdr_$call->{ret}, (char *)&ret);"); - $single_ret_var = "vir${type_name}Ptr rv = NULL"; - $single_ret_type = "vir${type_name}Ptr"; - } - } elsif ($ret_member =~ m/^remote_typed_param (\S+)<(\S+)>;\s*\/\*\s*insert@(\d+)\s*\*\//) { - splice(@args_list, int($3), 0, ("virTypedParameterPtr $1")); - push(@ret_list2, "if (remoteDeserializeTypedParameters(ret.$1.$1_val,\n" . - " ret.$1.$1_len,\n" . - " $2,\n" . - " $1,\n" . - " n$1) < 0)\n" . - " goto cleanup;\n"); - $single_ret_cleanup = 1; - } elsif ($ret_member =~ m/^remote_typed_param (\S+)<\S+>;/) { - # error out on unannotated arrays - die "remote_typed_param array without insert@<offset> annotation: $ret_member"; - } elsif ($ret_member =~ m/^int (\S+);/) { - my $arg_name = $1; - - if ($call->{ProcName} =~ m/GetAutostart$/) { - push(@args_list, "int *$arg_name"); - push(@ret_list, "if ($arg_name) *$arg_name = ret.$arg_name;"); - push(@ret_list, "rv = 0;"); - } else { - push(@ret_list, "rv = ret.$arg_name;"); - } - - $single_ret_var = "int rv = -1"; - $single_ret_type = "int"; - } elsif ($ret_member =~ m/^unsigned hyper (\S+);/) { - my $ret_name = $1; - - if ($call->{ProcName} =~ m/Get(Lib)?Version/) { - push(@args_list, "unsigned long *$ret_name"); - push(@ret_list, "if ($ret_name) HYPER_TO_ULONG(*$ret_name, ret.$ret_name);"); - push(@ret_list, "rv = 0;"); - $single_ret_var = "int rv = -1"; - $single_ret_type = "int"; - } elsif (hyper_to_long($call->{ProcName}, "ret", $ret_name)) { - push(@ret_list, "HYPER_TO_ULONG(rv, ret.$ret_name);"); - $single_ret_var = "unsigned long rv = 0"; - $single_ret_type = "unsigned long"; - } else { - push(@ret_list, "rv = ret.$ret_name;"); - $single_ret_var = "unsigned long long rv = 0"; - $single_ret_type = "unsigned long long"; - } - } elsif ($ret_member =~ m/^(\/)?\*/) { - # ignore comments - } else { - die "unhandled type for return value for procedure " . - "$call->{name}: $ret_member"; - } - } - } - - # select struct type for multi-return-value functions - if ($multi_ret) { - if (!(defined $call->{ret_offset})) { - die "multi-return-value without insert@<offset> annotation: $call->{ret}"; - } - - my $struct_name = $call->{ProcName}; - $struct_name =~ s/Get//; - - splice(@args_list, $call->{ret_offset}, 0, ("vir${struct_name}Ptr result")); - } - - if ($call->{streamflag} ne "none") { - splice(@args_list, $call->{streamoffset}, 0, ("virStreamPtr st")); - } - - # print function - print "\n"; - print "static $single_ret_type\n"; - print "remote$call->{ProcName}("; - - print join(", ", @args_list); - - print ")\n"; - print "{\n"; - print " $single_ret_var;\n"; - print " struct private_data *priv = $priv_src->$priv_name;\n"; - - foreach my $var (@vars_list) { - print " $var;\n"; - } - - if ($single_ret_as_list) { - print " int i;\n"; - } - - if ($call->{streamflag} ne "none") { - print " struct private_stream_data *privst = NULL;\n"; - } - - print "\n"; - print " remoteDriverLock(priv);\n"; - - if ($call->{streamflag} ne "none") { - print "\n"; - print " if (!(privst = remoteStreamOpen(st, REMOTE_PROC_$call->{UC_NAME}, priv->counter)))\n"; - print " goto done;\n"; - print "\n"; - print " st->driver = &remoteStreamDrv;\n"; - print " st->privateData = privst;\n"; - } - - if ($call->{ProcName} eq "SupportsFeature") { - # SPECIAL: VIR_DRV_FEATURE_REMOTE feature is handled directly - print "\n"; - print " if (feature == VIR_DRV_FEATURE_REMOTE) {\n"; - print " rv = 1;\n"; - print " goto done;\n"; - print " }\n"; - } - - foreach my $args_check (@args_check_list) { - print "\n"; - print " if ($args_check->{arg} > $args_check->{limit}) {\n"; - print " remoteError(VIR_ERR_RPC,\n"; - print " _(\"%s length greater than maximum: %d > %d\"),\n"; - print " $args_check->{name}, (int)$args_check->{arg}, $args_check->{limit});\n"; - print " goto done;\n"; - print " }\n"; - } - - if ($single_ret_as_list) { - print "\n"; - print " if ($single_ret_list_max_var > $single_ret_list_max_define) {\n"; - print " remoteError(VIR_ERR_RPC,\n"; - print " _(\"too many remote ${single_ret_list_error_msg_type}s: %d > %d\"),\n"; - print " $single_ret_list_max_var, $single_ret_list_max_define);\n"; - print " goto done;\n"; - print " }\n"; - } - - if (@setters_list) { - print "\n"; - print " "; - } - - print join("\n ", @setters_list); - - if (@setters_list) { - print "\n"; - } - - if (@setters_list2) { - print "\n"; - print " "; - } - - print join("\n ", @setters_list2); - - if (@setters_list2) { - print "\n"; - } - - if ($call->{ret} ne "void") { - print "\n"; - print " memset(&ret, 0, sizeof ret);\n"; - } - - print "\n"; - print " if (call($priv_src, priv, 0, ${procprefix}_PROC_$call->{UC_NAME},\n"; - print " (xdrproc_t)xdr_$call->{args}, (char *)$call_args,\n"; - print " (xdrproc_t)xdr_$call->{ret}, (char *)$call_ret) == -1) {\n"; - - if ($call->{streamflag} ne "none") { - print " remoteStreamRelease(st);\n"; - } - - print " goto done;\n"; - print " }\n"; - print "\n"; - - if ($single_ret_as_list) { - print " if (ret.$single_ret_list_name.${single_ret_list_name}_len > $single_ret_list_max_var) {\n"; - print " remoteError(VIR_ERR_RPC,\n"; - print " _(\"too many remote ${single_ret_list_error_msg_type}s: %d > %d\"),\n"; - print " ret.$single_ret_list_name.${single_ret_list_name}_len, $single_ret_list_max_var);\n"; - print " goto cleanup;\n"; - print " }\n"; - print "\n"; - print " /* This call is caller-frees (although that isn't clear from\n"; - print " * the documentation). However xdr_free will free up both the\n"; - print " * names and the list of pointers, so we have to strdup the\n"; - print " * names here. */\n"; - print " for (i = 0; i < ret.$single_ret_list_name.${single_ret_list_name}_len; ++i) {\n"; - print " ${single_ret_list_name}[i] = strdup(ret.$single_ret_list_name.${single_ret_list_name}_val[i]);\n"; - print "\n"; - print " if (${single_ret_list_name}[i] == NULL) {\n"; - print " for (--i; i >= 0; --i)\n"; - print " VIR_FREE(${single_ret_list_name}[i]);\n"; - print "\n"; - print " virReportOOMError();\n"; - print " goto cleanup;\n"; - print " }\n"; - print " }\n"; - print "\n"; - } - - if (@ret_list2) { - print " "; - print join("\n ", @ret_list2); - print "\n"; - } - - if (@ret_list) { - print " "; - print join("\n ", @ret_list); - print "\n"; - } - - if ($call->{ProcName} eq "DomainDestroy" || - $call->{ProcName} eq "DomainSave" || - $call->{ProcName} eq "DomainManagedSave") { - # SPECIAL: virDomain{Destroy|Save|ManagedSave} need to reset - # the domain id explicitly on success - print " dom->id = -1;\n"; - } - - if ($multi_ret or !@ret_list) { - print " rv = 0;\n"; - } - - if ($single_ret_as_list or $single_ret_cleanup) { - print "\n"; - print "cleanup:\n"; - print " xdr_free((xdrproc_t)xdr_remote_$call->{name}_ret, (char *)&ret);\n"; - } - - print "\n"; - print "done:\n"; - print " remoteDriverUnlock(priv);\n"; - print " return rv;\n"; - print "}\n"; - } -} |