libvirt/daemon/remote_generator.pl

#!/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, $gen, %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/) {
        $name = $1;
        $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 => []
            }
        }

        $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}"
            }

            $gen = $opt_b ? $1 : $2;

            if ($gen eq "autogen") {
                push(@autogen, $ProcName);
            } elsif ($gen eq "skipgen") {
                # ignore it
            } else {
                die "invalid generator flags for ${procprefix}_PROC_${name}"
            }
        }

        $calls[$id] = $calls{$name};

        $collect_args_members = 0;
        $collect_ret_members = 0;
    } else {
        $collect_args_members = 0;
        $collect_ret_members = 0;
    }
}

close(PROTOCOL);

#----------------------------------------------------------------------
# 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) {
        # skip things which are REMOTE_MESSAGE
        next if $calls{$_}->{msg};

        # skip procedures not on generate list
        next if ! exists($generate{$calls{$_}->{ProcName}});

        my $has_node_device = 0;
        my @vars_list = ();
        my @optionals_list = ();
        my @getters_list = ();
        my @args_list = ();
        my @ret_list = ();
        my @free_list = ();
        my @free_list_on_error = ("remoteDispatchError(rerr);");

        # handle arguments to the function
        if ($calls{$_}->{args} ne "void") {
            # node device is special, as it's identified by name
            if ($calls{$_}->{args} =~ m/^remote_node_device_/ and
                !($calls{$_}->{args} =~ m/^remote_node_device_lookup_by_name_/) and
                !($calls{$_}->{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 (@{$calls{$_}->{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_nonnull_string|remote_uuid|opaque) (\S+)<\S+>;/) {
                    if (! @args_list) {
                        push(@args_list, "conn");
                    }

                    if ($calls{$_}->{ProcName} eq "SecretSetValue") {
                        push(@args_list, "(const unsigned char *)args->$2.$2_val");
                    } elsif ($calls{$_}->{ProcName} eq "CPUBaseline") {
                        push(@args_list, "(const char **)args->$2.$2_val");
                    } else {
                        push(@args_list, "args->$2.$2_val");
                    }

                    push(@args_list, "args->$2.$2_len");
                } 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|hyper) (\S+);/) {
                    if (! @args_list) {
                        push(@args_list, "conn");
                    }

                    push(@args_list, "args->$3");
                } 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 ($calls{$_}->{ret} ne "void" and
            scalar(@{$calls{$_}->{ret_members}}) > 1) {
            $multi_ret = 1;
        }

        if ($calls{$_}->{ret} ne "void") {
            foreach my $ret_member (@{$calls{$_}->{ret_members}}) {
                if ($multi_ret) {
                    if ($ret_member =~ m/^(unsigned )?(char|short|int|hyper) (\S+)\[\S+\];/) {
                        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+)>;/) {
                    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_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;

                    if ($calls{$_}->{ProcName} eq "NodeListDevices") {
                        my $conn = shift(@args_list);
                        my $cap = shift(@args_list);
                        unshift(@args_list, "ret->$1.$1_val");
                        unshift(@args_list, $cap);
                        unshift(@args_list, $conn);
                    } else {
                        my $conn = shift(@args_list);
                        unshift(@args_list, "ret->$1.$1_val");
                        unshift(@args_list, $conn);
                    }
                } elsif ($ret_member =~ m/^remote_nonnull_string (\S+);/) {
                    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_nonnull_(domain|network|storage_pool|storage_vol|interface|node_device|secret|nwfilter|domain_snapshot) (\S+);/) {
                    my $type_name = name_to_ProcName($1);

                    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+)>;/) {
                    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_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;

                    my $conn = shift(@args_list);
                    unshift(@args_list, "ret->$1.$1_val");
                    unshift(@args_list, $conn);
                } elsif ($ret_member =~ m/^int (\S+);/) {
                    push(@vars_list, "int $1");
                    push(@ret_list, "ret->$1 = $1;");
                    $single_ret_var = $1;

                    if ($calls{$_}->{ProcName} =~ m/GetAutostart$/) {
                        $single_ret_by_ref = 1;
                    } else {
                        $single_ret_by_ref = 0;

                        if ($calls{$_}->{ProcName} eq "CPUCompare") {
                            $single_ret_check = " == VIR_CPU_COMPARE_ERROR";
                        } else {
                            $single_ret_check = " < 0";
                        }
                    }
                } elsif ($ret_member =~ m/^hyper (\S+)<(\S+)>;/) {
                    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_define = $2;

                    my $conn = shift(@args_list);

                    if ($calls{$_}->{ProcName} eq "NodeGetCellsFreeMemory") {
                        $single_ret_check = " <= 0";
                        $single_ret_list_max_var = "maxCells";
                        unshift(@args_list, "(unsigned long long *)ret->$1.$1_val");
                    } else {
                        $single_ret_check = " < 0";
                        $single_ret_list_max_var = "max$1";
                        unshift(@args_list, "ret->$1.$1_val");
                    }

                    unshift(@args_list, $conn);
                } elsif ($ret_member =~ m/^(unsigned )?hyper (\S+);/) {
                    my $type_name;
                    my $ret_name = $2;

                    $type_name = $1 if ($1);
                    $type_name .= "long";

                    push(@vars_list, "$type_name $ret_name");
                    push(@ret_list, "ret->$ret_name = $ret_name;");
                    $single_ret_var = $ret_name;

                    if ($calls{$_}->{ProcName} eq "DomainGetMaxMemory" or
                        $calls{$_}->{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/^(\/)?\*/) {
                    # ignore comments
                } else {
                    die "unhandled type for return value: $ret_member";
                }
            }
        }

        # select struct type for multi-return-value functions
        if ($multi_ret) {
            if (! @args_list) {
                push(@args_list, "conn");
            }

            my $struct_name = $calls{$_}->{ProcName};
            $struct_name =~ s/Get//;

            if ($calls{$_}->{ProcName} eq "DomainGetBlockInfo") {
                # SPECIAL: virDomainGetBlockInfo has flags parameter after
                #          the struct parameter in its signature
                my $flags = pop(@args_list);
                push(@args_list, "&tmp");
                push(@args_list, $flags);
            } elsif ($calls{$_}->{ProcName} eq "DomainBlockStats" ||
                     $calls{$_}->{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";
                push(@args_list, "&tmp");
                push(@args_list, "sizeof tmp");
            } else {
                push(@args_list, "&tmp");
            }

            push(@vars_list, "vir$struct_name tmp");
        }

        # print functions signature
        print "\n";
        print "static int\n";
        print "${structprefix}Dispatch$calls{$_}->{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 "    $calls{$_}->{args} *args";

        if ($calls{$_}->{args} eq "void") {
            print " ATTRIBUTE_UNUSED"
        }

        print ",\n";
        print "    $calls{$_}->{ret} *ret";

        if ($calls{$_}->{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";
        }

        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 ($calls{$_}->{ret} eq "void") {
            print "    if (vir$calls{$_}->{ProcName}(";
            print join(', ', @args_list);
            print ") < 0)\n";
            print "        goto cleanup;\n";
            print "\n";
        } elsif (!$multi_ret) {
            my $prefix = "";
            my $proc_name = $calls{$_}->{ProcName};

            if (! @args_list) {
                push(@args_list, "conn");

                if ($calls{$_}->{ProcName} ne "NodeGetFreeMemory") {
                    $prefix = "Connect"
                }
            }

            if ($calls{$_}->{ProcName} eq "GetSysinfo" or
                $calls{$_}->{ProcName} eq "GetMaxVcpus" or
                $calls{$_}->{ProcName} eq "DomainXMLFromNative" or
                $calls{$_}->{ProcName} eq "DomainXMLToNative" or
                $calls{$_}->{ProcName} eq "FindStoragePoolSources" or
                $calls{$_}->{ProcName} =~ m/^List/) {
                $prefix = "Connect"
            } elsif ($calls{$_}->{ProcName} eq "SupportsFeature") {
                $prefix = "Drv"
            } elsif ($calls{$_}->{ProcName} eq "CPUBaseline") {
                $proc_name = "ConnectBaselineCPU"
            } elsif ($calls{$_}->{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);
                print ", &$single_ret_var) < 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";

            if (@ret_list) {
                print "    ";
            }

            print join("\n    ", @ret_list);
            print "\n";
        } else {
            print "    if (vir$calls{$_}->{ProcName}(";
            print join(', ', @args_list);
            print ") < 0)\n";

            print "        goto cleanup;\n";
            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 $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+)>;/) {
                    push(@args_list, "const char **$1");
                    push(@args_list, "unsigned int ${1}len");
                    push(@setters_list, "args.$1.${1}_val = (char **)$1;");
                    push(@setters_list, "args.$1.${1}_len = ${1}len;");
                    push(@args_check_list, { name => "\"$1\"", arg => "${1}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/^(remote_string|opaque) (\S+)<(\S+)>;/) {
                    my $type_name = $1;
                    my $arg_name = $2;
                    my $limit = $3;

                    if ($call->{ProcName} eq "SecretSetValue") {
                        push(@args_list, "const unsigned char *$arg_name");
                        push(@args_list, "size_t ${arg_name}len");
                    } elsif ($call->{ProcName} eq "DomainPinVcpu") {
                        push(@args_list, "unsigned char *$arg_name");
                        push(@args_list, "int ${arg_name}len");
                    } else {
                        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|hyper) (\S+);/) {
                    my $type_name;
                    my $arg_name = $3;

                    $type_name = $1 if ($1);
                    $type_name .= $2;
                    $type_name =~ s/hyper/long/;

                    if ($type_name eq "int") {
                        # fix bad decisions in the xdr protocol
                        if ($arg_name eq "flags" and
                            $call->{ProcName} ne "DomainCoreDump" and
                            $call->{ProcName} ne "DomainGetXMLDesc" and
                            $call->{ProcName} ne "NetworkGetXMLDesc") {
                            $type_name = "unsigned int";
                        } elsif ($arg_name eq "nvcpus" and
                                 $call->{ProcName} eq "DomainSetVcpus") {
                            $type_name = "unsigned int";
                        } elsif ($arg_name eq "vcpu" and
                                 $call->{ProcName} eq "DomainPinVcpu") {
                            $type_name = "unsigned int";
                        }
                    }

                    if ($call->{ProcName} eq "DomainMigrateSetMaxDowntime" and
                        $arg_name eq "downtime") {
                        $type_name = "unsigned 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 $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 $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+\];/) {
                        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+);/) {
                        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+)>;/) {
                    $single_ret_as_list = 1;
                    $single_ret_list_name = $1;
                    $single_ret_list_max_var = "max$1";
                    $single_ret_list_max_define = $2;

                    my $first_arg = shift(@args_list);
                    my $second_arg;

                    if ($call->{ProcName} eq "NodeListDevices") {
                        $second_arg = shift(@args_list);
                    }

                    unshift(@args_list, "char **const $1");

                    if (defined $second_arg) {
                        unshift(@args_list, $second_arg);
                    }

                    unshift(@args_list, $first_arg);

                    push(@ret_list, "rv = ret.$1.$1_len;");
                    $single_ret_var = "int rv = -1";
                    $single_ret_type = "int";
                } 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 ($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/^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 $arg_name = $1;
                    if ($call->{ProcName} =~ m/Get(Lib)?Version/) {
                        push(@args_list, "unsigned long *$arg_name");
                        push(@ret_list, "if ($arg_name) *$arg_name = ret.$arg_name;");
                        push(@ret_list, "rv = 0;");
                        $single_ret_var = "int rv = -1";
                        $single_ret_type = "int";
                    } else {
                        push(@ret_list, "rv = ret.$arg_name;");
                        $single_ret_var = "unsigned long rv = 0";
                        $single_ret_type = "unsigned long";
                    }
                } elsif ($ret_member =~ m/^hyper (\S+);/) {
                    my $arg_name = $1;

                    if ($call->{ProcName} eq "NodeGetFreeMemory") {
                        push(@ret_list, "rv = ret.$arg_name;");
                        $single_ret_var = "unsigned long long rv = 0";
                        $single_ret_type = "unsigned long long";
                    } else {
                        die "unhandled type for return value: $ret_member";
                    }
                } 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) {
            my $last_arg;
            my $struct_name = $call->{ProcName};
            $struct_name =~ s/Get//;

            if ($call->{ProcName} eq "DomainGetBlockInfo") {
                # SPECIAL: virDomainGetBlockInfo has flags parameter after
                #          the struct parameter in its signature
                $last_arg = pop(@args_list);
            }

            push(@args_list, "vir${struct_name}Ptr result");

            if (defined $last_arg) {
                push(@args_list, $last_arg);
            }
        }

        # 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";
        }

        print "\n";
        print "    remoteDriverLock(priv);\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 ($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";
        print "        goto done;\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_list) {
            print "    ";
            print join("\n    ", @ret_list);
            print "\n";
        }

        if ($call->{ProcName} eq "DomainDestroy") {
            # SPECIAL: virDomainDestroy needs to reset the domain id explicitly
            print "    dom->id = -1;\n";
        }

        if ($multi_ret or !@ret_list) {
            print "    rv = 0;\n";
        }

        if ($single_ret_as_list) {
            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";
    }
}