#!/usr/bin/env perl
# IBM(c) 2007 EPL license http://www.eclipse.org/legal/epl-v10.html
package xCAT::Client;

BEGIN
{
    $::XCATROOT = $ENV{'XCATROOT'} ? $ENV{'XCATROOT'} : -d '/opt/xcat' ? '/opt/xcat' : '/usr';
}

# if AIX - make sure we include perl 5.8.2 in INC path.
#       Needed to find perl dependencies shipped in deps tarball.
use Storable qw/nstore_fd fd_retrieve/;
if ($^O =~ /^aix/i) {
    unshift(@INC, qw(/usr/opt/perl5/lib/5.8.2/aix-thread-multi /usr/opt/perl5/lib/5.8.2 /usr/opt/perl5/lib/site_perl/5.8.2/aix-thread-multi /usr/opt/perl5/lib/site_perl/5.8.2));
}
use IO::Handle;
use MIME::Base64 qw(decode_base64);
use IO::Socket::SSL;

my $inet6support;
if ($^O =~ /^aix/i) {    # disable AIX IPV6  TODO fix
    $inet6support = 0;
} else {
    $inet6support = eval { require Socket6; 1; };
}
if ($inet6support) {
    $inet6support = eval { require IO::Socket::INET6; 1; };
}
if ($inet6support) {
    $inet6support = eval { require IO::Socket::SSL; IO::Socket::SSL->import('inet6'); 1; };
}

if ($^O =~ /^linux/i) {

    # Is IPv6 enabled on the MN or xcat client node at all?
    my $ipv6enabled = `ip -6 -o addr 2> /dev/null`;
    if (!$ipv6enabled) {
        $inet6support = 0;
    }
}

unless ($inet6support) {
    eval { require Socket };
    eval { require IO::Socket::INET };
    eval { require IO::Socket::SSL; IO::Socket::SSL->import('inet4') };
}


use XML::Simple;    #smaller than libxml....
use Fcntl;
use POSIX qw/:errno_h/;
use IO::Select;
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';

#require Data::Dumper;
my $xcathost = 'localhost:3001';
my $plugins_dir;
my %resps;
my $EXITCODE; # save the bitmask of all exit codes returned by calls to handle_response()
1;


sub rspclean {
    my $response = shift;
    my $callback = shift;
    my $rsps     = XMLin($response, SuppressEmpty => undef, ForceArray => 1);
    foreach my $rsp (@{ $rsps->{xcatresponse} }) {

        #add ESC back
        foreach my $key (keys %$rsp) {
            if (ref($rsp->{$key}) eq 'ARRAY') {
                foreach my $text (@{ $rsp->{$key} }) {
                    next unless defined $text;
                    $text =~ s/xxxxESCxxxx/\e/g;
                }
            }
            else {
                $rsp->{$key} =~ s/xxxxESCxxxx/\e/g;
            }
        }
        $callback->($rsp);
        if ($rsp->{serverdone}) {
            return 1;
        }
    }
    return 0;
}

sub send_request {
    my $request = shift;
    my $sock    = shift;
    my $encode  = shift;
    if ($encode eq "xml") {
        my $msg = XMLout($request, RootName => 'xcatrequest', NoAttr => 1, KeyAttr => []);
        if ($ENV{XCATXMLTRACE}) { print $msg; }
        if ($ENV{XCATXMLWARNING}) {
            validateXML($msg);
        }
        print $sock $msg;
        $sock->flush();
    } else {
        nstore_fd($request, $sock);
        $sock->flush();
    }
}
#################################
# submit_request will take an xCAT command and pass it to the xCAT
#   server for execution.
#  Note must not put a require or use for Utils.pm in the non-bypass path
#
# If the XCATBYPASS env var is set, the connection to the server/daemon
#   will be bypassed and the plugin will be called directly.  If it is
#   set to one or more directories (separated by ":"), all perl modules
#   in those directories will be loaded in as plugins (for duplicate
#   commands, last one in wins). If it is set to any other value
#   (e.g. "yes", "default", whatever string you want) the default plugin
#   directory /opt/xcat/lib/perl/xCAT_plugin will be used.
#
# Input:
#    Request hash - A hash ref containing the input command and args to be
#       passed to the plugin.  The the xcatd daemon (or this routine when
#       XCATBYPASS) reads the {noderange} entry and builds a flattened array
#       of nodes that gets added as request->{node}
#       The format for the request hash is:
#          { command => [ 'xcatcmd' ],
#            noderange => [ 'noderange_string' ],
#            arg => [ 'arg1', 'arg2', '...', 'argn' ]
#          }
#    Callback - A subroutine ref that will be called to process the output
#       from the plugin.
#
# NOTE:  The request hash will get converted to XML when passed to the
#        xcatd daemon, and will get converted back to a hash before being
#        passed to the plugin.  The XMLin ForceArray option is used to
#        force all XML constructs to be arrays so that the plugin code
#        and callback routines can access the data consistently.
#        The input request and the response hash created by the plugin should
#        always create hashes with array values.
#################################
sub submit_request {
    my $request  = shift;
    my $callback = shift;
    my $keyfile  = shift;
    my $certfile = shift;
    my $cafile   = shift;

    # get home directory
    my @user    = getpwuid($>);
    my $homedir = $user[7];
    unless ($keyfile)  { $keyfile  = $homedir . "/.xcat/client-cred.pem"; }
    unless ($certfile) { $certfile = $homedir . "/.xcat/client-cred.pem"; }
    unless ($cafile)   { $cafile   = $homedir . "/.xcat/ca.pem"; }
    $xCAT::Client::EXITCODE = 0; # clear out exit code before invoking the plugin
    if (ref($request) eq 'HASH') {    # the request is an array, not pure XML
        $request->{clienttype}->[0] = "cli";    # setup clienttype for auditlog
    }

    # If XCATBYPASS is set, invoke the plugin process_request method directly
    # without going through the socket connection to the xcatd daemon
    if ($ENV{XCATBYPASS}) {

        #add current userid to the request
        if (ref($request) eq 'HASH') {   # the request is an array, not pure XML
            if (!(defined($request->{username}))) {
                $request->{username}->[0] = getpwuid($>);
            }

            # only allow root to run
            unless ($request->{username}->[0] =~ /root/) {
                print("WARNING: Only allow root to run XCATBYPASS mode, your current user ID is $request->{username}->[0].\n");
                return 0;
            }
        }

        # Load plugins from either specified or default dir
        require xCAT::Table;
        my %cmd_handlers;
        my @plugins_dirs = split('\:', $ENV{XCATBYPASS});
        if (-d $plugins_dirs[0]) {
            foreach (@plugins_dirs) {
                $plugins_dir = $_;
                scan_plugins();
            }
        } else {

            # figure out default plugins dir
            #my $sitetab=xCAT::Table->new('site');
            #unless ($sitetab) {
            #  print ("ERROR: Unable to open basic site table for configuration\n");
            #}
            $plugins_dir = $::XCATROOT . '/lib/perl/xCAT_plugin';
            scan_plugins();
        }

        populate_site_hash();

        #  don't do XML transformation -- assume request is well-formed
        #  my $xmlreq=XMLout($request,RootName=>xcatrequest,NoAttr=>1,KeyAttr=>[]);
        #  $request = XMLin($xmlreq,SuppressEmpty=>undef,ForceArray=>1) ;


        # Call the plugin directly
        #   ${"xCAT_plugin::".$modname."::"}{process_request}->($request,$callback);
        plugin_command($request, undef, $callback);
        return 0;
    }

    # No XCATBYPASS, so establish a socket connection with the xcatd daemon
    # and submit the request
    if ($ENV{XCATHOST}) {
        $xcathost = $ENV{XCATHOST};
    }
    my %connargs = ();
    if ($xcathost =~ s/%([^\]|:]*)//) {
        $connargs{PeerScope} = $1;
    }
    $connargs{PeerAddr} = $xcathost;
    $connargs{Timeout}  = 15;
    if ($connargs{PeerScope} and $connargs{PeerScope} =~ /[a-zA-Z]/) { #non-numeric, need to translate...
        my @ipdata = `ip link`;
        @ipdata = grep(/[^@]$connargs{PeerScope}(:|@)/, @ipdata);
        if (scalar(@ipdata) != 1) {
            print STDERR "Unable to identify scope " . $connargs{PeerScope} . "\n";
            exit(1);
        }
        $connargs{PeerScope} = $ipdata[0];
        $connargs{PeerScope} =~ s/:.*//;
    }


    my $pclient;
    if ($inet6support) {
        $pclient = IO::Socket::INET6->new(
            %connargs,
        );
    } else {
        $pclient = IO::Socket::INET->new(
            PeerAddr => $xcathost,
            Timeout  => 15,
        );
    }
    unless ($pclient) {
        print "Unable to open socket connection to xcatd daemon on $xcathost.\n";
        print "Verify that the xcatd daemon is running and that your SSL setup is correct.\n";
        if ($@ =~ /SSL Timeout/) {
            die "Connection failure: SSL Timeout or incorrect certificates in ~/.xcat";
        } else {
            die "Connection failure: $@"
        }
    }
    my $client;
    my %sslargs;
    if (defined($ENV{'XCATSSLVER'})) {
        $sslargs{SSL_version} = $ENV{'XCATSSLVER'};
    }
    if (-r $keyfile and -r $certfile and -r $cafile) {
        $client = IO::Socket::SSL->start_SSL($pclient,
            SSL_key_file        => $keyfile,
            SSL_cert_file       => $certfile,
            SSL_ca_file         => $cafile,
            SSL_verify_mode     => SSL_VERIFY_PEER,
            SSL_verifycn_scheme => "none",
            SSL_use_cert        => 1,
            Timeout             => 0,
            %sslargs,
        );
    } else {
        print "warning: the client certificates under $homedir/.xcat/ are not setup correctly, please run '/opt/xcat/share/xcat/scripts/setup-local-client.sh"." $ENV{'USER'}' as 'root' to generate the client certificates; otherwise, the SSL connection between xcat client and xcatd will be setup without certificate verification and open to Man-In-The-Middle attacks.\n";
        #Using the default of SSL_verify_mode of SSL_VERIFY_NONE for client is deprecated!
        #need to specify SSL_verify_mode => SSL_VERIFY_NONE explicitly
        $client = IO::Socket::SSL->start_SSL($pclient,
            SSL_verify_mode => SSL_VERIFY_NONE,
            Timeout => 0,
        );
    }
    unless ($client) {
        print "Unable to open socket connection to xcatd daemon on $xcathost.\n";
        print "Verify that the xcatd daemon is running and that your SSL setup is correct.\n";
        if ($@ =~ /SSL Timeout/) {
            die "Connection failure: SSL Timeout or incorrect certificates in ~/.xcat";
        } else {
            die "Connection failure: $@"
        }
    }

    my $msg;
    my $encode = "xml";

    #storable encoding is unsafe, carry on with the unsafe xml scheme
    #perhaps one day will support faster schemes
    #my $encode = "storable";
    #my $straightprint=0;
    #if ($ENV{XCATXMLTRACE} or $ENV{XCATXMLWARNING}) { $encode="xml"; }
    if (ref($request) eq 'HASH') {    # the request is an array, not pure XML
                                      #print $client "xcatencoding: $encode\n";
                                      #my $encok=<$client>;
        send_request($request, $client, $encode);
    } else {                          #XML
        $straightprint = 1;
        $msg           = $request;
        print $client $msg;
    }

    # when receive TERM or INT (ctrl^c) from user, sleep 2s before exit to make
    # sure the server (xcatd) has recevied 'abortcommand' command
    $SIG{TERM} = $SIG{INT} = sub { send_request({ abortcommand => [1] }, $client, $encode); sleep 2; exit 0; };
    my $response;
    my $rsp;
    my $cleanexit = 0;
    if ($encode eq 'xml') {
        my $massresponse     = "<massresponse>";
        my $nextcoalescetime = time() + 1;
        my $coalescenow      = 0;
        my $flags            = fcntl($client, F_GETFL, 0);
        $flags |= O_NONBLOCK; #select can be a bit.. fickle, make sysread work more easily...
        fcntl($client, F_SETFL, $flags);
        my $clientsel = new IO::Select;
        $clientsel->add($client);
        my $line;
        my $newdata = 0;

        while (1) {
            my $shouldexit;
            if ($newdata and ($coalescenow or time() > $nextcoalescetime)) {
                $coalescenow      = 0;
                $newdata          = 0;
                $nextcoalescetime = time() + 1;
                $massresponse .= "</massresponse>";
                $shouldexit = rspclean($massresponse, $callback);
                $massresponse = "<massresponse>";
            }

            if ($shouldexit) {
                $cleanexit = 1;
                last;
            }
            $line = "";
            $clientsel->can_read(0.5);
            my $readbytes;
            do { $readbytes = sysread($client, $line, 65535, length($line)); } while ($readbytes);
            unless (length($line)) {
                if (not defined $readbytes and $! == EAGAIN) { next; }
                last;
            }
            $newdata = 1;
            $response .= $line;
            if ($line =~ m/<\/xcatresponse>\s*\z/) {
                if ($line =~ /serverdone/) { $coalescenow = 1; } #if serverdone was detected, hint at coalesce code to flush things out now
                    #this means that coalesce can be triggered by stray words in the output prematurely, but that's harmless
                    #replace ESC with xxxxESCxxx because XMLin cannot handle it
                $response =~ s/\e/xxxxESCxxxx/g;

                if ($ENV{XCATXMLTRACE}) { print $response; }
                $massresponse .= $response;
                $response = '';
                if ($ENV{XCATXMLWARNING}) {
                    validateXML($response);
                }
            }
        }
        if (not $cleanexit and $massresponse ne "<massresponse>") {
            $massresponse .= "</massresponse>";
            $cleanexit = rspclean($massresponse, $callback);
        }
    } else {    #storable encode
        my $rsp;
        eval { $rsp = fd_retrieve($client); };
      SERVERINPUT: while ($rsp) {
            my @rsps;
            if (ref $rsp eq 'ARRAY') {
                @rsps = @$rsp;
            } else {
                @rsps = ($rsp);
            }
            foreach (@rsps) {
                $callback->($_);
                if ($_->{serverdone}) {
                    $cleanexit = 1;
                    last SERVERINPUT;
                }
            }
            $rsp = undef;
            eval { $rsp = fd_retrieve($client); };
        }
    }
    $massresponse = "";
    unless ($cleanexit) {
        print STDERR "ERROR/WARNING: communication with the xCAT server seems to have been ended prematurely\n";
        $xCAT::Client::EXITCODE = 1;
    }

    sub validateXML {
        my $xml            = shift;
        my @lines          = split /\n/, $xml;
        my $invalidNewline = 0;
        my $contentsColon  = 0;
        my $contentsLine;

        foreach (@lines) {
            if (!$invalidNewline) {
                if (($_ =~ /<contents>/ && $_ !~ /<\/contents>/) ||
                    ($_ =~ /<desc>/ && $_ !~ /<\/desc>/)) {
                    $invalidNewline = 1;
                    print "Possible invalid XML using newlines found:  \n$xml\n";
                }
            }
            if ($_ =~ /<contents>.+:.+<\/contents>/) {
                $contentsColon = 1;
                $contentsLine  = $_;
            }
            if ($_ =~ /<desc>.+<\/desc>/) {
                $contentsColon = 0;
            }
            if ($contentsColon && $_ =~ /<desc><\/desc>/) {
                print "Possible invalid XML found(data contents using colon and blank description):  \n$contentsLine\n$_\n";
                $contentsColon = 0;
            }
        }
    }

###################################
    # scan_plugins
    #    will load all plugin perl modules and build a list of supported
    #    commands
    #
    # NOTE:  This is copied from xcatd (last merge 11/23/09).
    # TODO:  Will eventually move to using common source....
###################################
    sub scan_plugins {
        my @plugins = glob($plugins_dir . "/*.pm");
        foreach (@plugins) {
            /.*\/([^\/]*).pm$/;
            my $modname = $1;
            unless (eval { require "$_" }) {

                #       xCAT::MsgUtils->message("S","Error loading module ".$_."  ...skipping");
                print "Error loading module $_  ...skipping\n";
                next;
            }
            no strict 'refs';
            my $cmd_adds = ${ "xCAT_plugin::" . $modname . "::" }{handled_commands}->();
            foreach (keys %$cmd_adds) {
                my $value = $_;
                if (defined($cmd_handlers{$_})) {
                    push @{ $cmd_handlers{$_} }, [ $modname, $cmd_adds->{$_} ];
                } else {
                    $cmd_handlers{$_} = [ [ $modname, $cmd_adds->{$_} ] ];
                }
            }
        }
        foreach (@plugins) {
            no strict 'refs';
            /.*\/([^\/]*).pm$/;
            my $modname = $1;
            unless (defined(${ "xCAT_plugin::" . $modname . "::" }{init_plugin})) {
                next;
            }
            ${ "xCAT_plugin::" . $modname . "::" }{init_plugin}->(\&do_request);
        }
    }




###################################
    # plugin_command
    #    will invoke the correct plugin
    #
    # NOTE:  This is copied from xcatd (last merge 11/23/09).
    # TODO:  Will eventually move to using common source....
###################################
    sub plugin_command {
        my $req      = shift;
        my $sock     = shift;
        my $callback = shift;
        my %handler_hash;
        my $usesiteglobal = 0;

        # We require these only in bypass mode to reduce start up time for the normal case
        #use lib "$::XCATROOT/lib/perl";
        #use xCAT::NodeRange;
        require lib;
        lib->import("$::XCATROOT/lib/perl");
        require xCAT::NodeRange;
        require xCAT::Table;

        $Main::resps = {};
        my $xmlreq;
        if (ref($req) ne 'HASH') {    # the request XML, get an array
            $xmlreq = $req;           # save the original XML
            $req = XMLin($xmlreq, SuppressEmpty => undef, ForceArray => 1);

        }
        my @nodes;
        if ($req->{node}) {
            @nodes = @{ $req->{node} };
        } elsif ($req->{noderange} and $req->{noderange}->[0]) {
            @nodes = xCAT::NodeRange::noderange($req->{noderange}->[0]);
            if (xCAT::NodeRange::nodesmissed()) {

                #     my $rsp = {errorcode=>1,error=>"Invalid nodes in noderange:".join(',',xCAT::NodeRange::nodesmissed)};
                #     my $rsp->{serverdone} = {};
                print "Invalid nodes in noderange:" . join(',', xCAT::NodeRange::nodesmissed()) . "\n";

                #     if ($sock) {
                #       print $sock XMLout($rsp,RootName=>'xcatresponse' ,NoAttr=>1);
                #     }
                #     return ($rsp);
                return 1;
            }
            unless (@nodes) {
                $req->{emptynoderange} = [1];
            }
        }
        if (@nodes) { $req->{node} = \@nodes; }
        my %unhandled_nodes;
        foreach (@nodes) {
            $unhandled_nodes{$_} = 1;
        }
        my $useunhandled = 0;
        if (defined($cmd_handlers{ $req->{command}->[0] })) {
            my $hdlspec;
            my @globalhandlers = ();
            my $useglobals = 1; #If it stays 1, then use globals normally, if 0, use only for 'unhandled_nodes, if -1, don't do at all
            foreach (@{ $cmd_handlers{ $req->{command}->[0] } }) {
                $hdlspec = $_->[1];
                my $ownmod = $_->[0];
                if ($hdlspec =~ /^site:/) {    #A site entry specifies a plugin
                    my $sitekey = $hdlspec;
                    $sitekey =~ s/^site://;

                    #$sitetab = xCAT::Table->new('site');
                    #my $sent = $sitetab->getAttribs({key=>$sitekey},['value']);
                    #if ($sent and $sent->{value}) { #A site style plugin specification is just like
                    if ($::XCATSITEVALS{$sitekey}) { #A site style plugin specification is just like
                           #a static global, it grabs all nodes rather than some
                        $useglobals = -1; #If they tried to specify anything, don't use the default global handlers at all
                        unless (@nodes) {
                            $handler_hash{ $::XCATSITEVALS{$sitekey} } = 1;
                            $usesiteglobal = 1;
                        }
                        foreach (@nodes) { #Specified a specific plugin, not a table lookup
                            $handler_hash{ $::XCATSITEVALS{$sitekey} }->{$_} = 1;
                        }
                    }
                } elsif ($hdlspec =~ /:/) { #Specificed a table lookup path for plugin name
                    if (@nodes) { # only use table lookup plugin if nodelist exists
                            # Usage will be handled in common AAAhelp plugin

                        $useglobals = 0; #Only contemplate nodes that aren't caught through searching below in the global handler
                        $useunhandled = 1;
                        my $table;
                        my $cols;
                        ($table, $cols) = split(/:/, $hdlspec);
                        my @colmns = split(/,/, $cols);
                        my @columns;
                        my $hdlrtable = xCAT::Table->new($table);
                        unless ($hdlrtable) {

                            #TODO: proper error handling
                        }
                        my $node;
                        my $colvals = {};
                        foreach my $colu (@colmns) {
                            if ($colu =~ /=/) { #a value redirect to a pattern/specific name
                                my $coln; my $colv;
                                ($coln, $colv) = split(/=/, $colu, 2);
                                $colvals->{$coln} = $colv;
                                push(@columns, $coln);
                            } else {
                                push(@columns, $colu);
                            }
                        }


                        unless (@nodes) { #register the plugin in the event of usage
                            $handler_hash{$ownmod} = 1;
                            $useglobals = 1;
                        }
                        my $hdlrcache;
                        if ($hdlrtable) {
                            $hdlrcache = $hdlrtable->getNodesAttribs(\@nodes, \@columns);
                        }
                        foreach $node (@nodes) {
                            unless ($hdlrcache) { next; }
                            my $attribs = $hdlrcache->{$node}->[0]; #$hdlrtable->getNodeAttribs($node,\@columns);
                            unless (defined($attribs)) { next; }
                            foreach (@columns) {
                                my $col = $_;
                                if (defined($attribs->{$col})) {
                                    if ($colvals->{$col}) { #A pattern match style request.
                                        if ($attribs->{$col} =~ /$colvals->{$col}/) {
                                            $handler_hash{$ownmod}->{$node} = 1;
                                            delete $unhandled_nodes{$node};
                                            last;
                                        }
                                    } else {

                                        # call the plugin that matches the table value for that node
                                        if ($attribs->{$col} =~ /$ownmod/) {
                                            $handler_hash{ $attribs->{$col} }->{$node} = 1;
                                            delete $unhandled_nodes{$node};
                                            last;
                                        }
                                    }
                                }
                            }
                        }
                        $hdlrtable->close;
                    }    # end if (@nodes)

                } else {
                    push @globalhandlers, $hdlspec;
                }
            }
            if ($useglobals == 1) { #Behavior when globals have not been overriden
                my $hdlspec;
                foreach $hdlspec (@globalhandlers) {
                    unless (@nodes) {
                        $handler_hash{$hdlspec} = 1;
                    }
                    foreach (@nodes) { #Specified a specific plugin, not a table lookup
                        $handler_hash{$hdlspec}->{$_} = 1;
                    }
                }
            } elsif ($useglobals == 0) {
                unless (@nodes or $usesiteglobal) { #if something like 'makedhcp -n',
                    foreach (keys %handler_hash) {
                        if ($handler_hash{$_} == 1) {
                            delete($handler_hash{$_})
                        }
                    }
                }
                foreach $hdlspec (@globalhandlers) {
                    unless (@nodes or $usesiteglobal) {
                        $handler_hash{$hdlspec} = 1;
                    }
                    foreach (keys %unhandled_nodes) { #Specified a specific plugin, not a table lookup
                        $handler_hash{$hdlspec}->{$_} = 1;
                    }
                }
            }    #Otherwise, global handler is implicitly disabled
        } else {
            print "Error request: $req->{command}->[0]  has no known plugin for it.\n";
            return 1;
        }
        if ($useunhandled) {
            my $queuelist;
            foreach (@{ $cmd_handlers{ $req->{command}->[0] } }) {
                my $queueitem = $_->[1];
                if (($queueitem =~ /:/) and !($queuelist =~ /($queueitem)/)) {
                    $queuelist .= "$_->[1];";
                }
            }
            $queuelist =~ s/;$//;
            $queuelist =~ s/:/./g;
            foreach (keys %unhandled_nodes) {

                #      if ($sock) {
                #         print $sock XMLout({node=>[{name=>[$_],data=>["Unable to identify plugin for this command, check relevant tables: $queuelist"],errorcode=>[1]}]},NoAttr=>1,RootName=>'xcatresponse');
                #      } else {
                my $tabdesc = $queuelist;
                $tabdesc =~ s/=.*$//;
                $callback->({ node => [ { name => [$_], error => [ 'Unable to identify plugin for this command, check relevant tables: ' . $tabdesc ], errorcode => [1] } ] });

                #      }
            }
        }

## FOR NOW, DON'T FORK CHILD PROCESS TO MAKE BYPASS SIMPLER AND EASIER TO DEBUG
        #  $plugin_numchildren=0;
        #  %plugin_children=();
        #  $SIG{CHLD} = \&plugin_reaper; #sub {my $plugpid; while (($plugpid = waitpid(-1, WNOHANG)) > 0) { if ($plugin_children{$plugpid}) { delete $plugin_children{$plugpid}; $plugin_numchildren--; } } };
        # my $check_fds;
        # if ($sock) {
        #   $check_fds = new IO::Select;
        # }
        foreach (keys %handler_hash) {
            my $modname = $_;

            #   my $shouldbealivepid=$$;
            if (-r $plugins_dir . "/" . $modname . ".pm") {
                require $plugins_dir . "/" . $modname . ".pm";

                #     $plugin_numchildren++;
                #     my $pfd; #will be referenced for inter-process messaging.
                #     my $parfd; #not causing a problem that I discern yet, but theoretically
                #     my $child;
                #     if ($sock) { #If $sock not passed in, don't fork..
                #       socketpair($pfd, $parfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
                #       #pipe($pfd,$cfd);
                #       $parfd->autoflush(1);
                #       $pfd->autoflush(1);
                #       $child = xCAT::Utils->xfork;
                #     } else {
                #       $child = 0;
                #     }
                #     unless (defined $child) { die "Fork failed"; }
                #     if ($child == 0) {
                #       if ($parfd) {  #If xCAT is doing multiple requests in same communication PID, things would get unfortunate otherwise
                #           $parent_fd = $parfd;
                #       }
                my $oldprogname = $$progname;
                $$progname = $oldprogname . ": $modname instance";

                #       if ($sock) { close $pfd; }
                unless ($handler_hash{$_} == 1) {
                    my @nodes = sort { ($a =~ /(\d+)/)[0] <=> ($b =~ /(\d+)/)[0] || $a cmp $b } (keys %{ $handler_hash{$_} });
                    $req->{node} = \@nodes;
                }
                no strict "refs";

                #       eval { #REMOVEEVALFORDEBUG
                #       if ($dispatch_requests) {
                # backup the original req and recover it after the a run
                my $org_req = {%$req};
                dispatch_request($req, $callback, $modname);
                $req = {%$org_req};

                #       } else {
                #          $SIG{CHLD}='DEFAULT';
                #          ${"xCAT_plugin::".$modname."::"}{process_request}->($req,$callback,\&do_request);
                #       }
                $$progname = $oldprogname;

                #       if ($sock) {
                #         close($parent_fd);
                #         xexit(0);
                #       }
                #       }; #REMOVEEVALFORDEBUG
                #       if ($sock or $shouldbealivepid != $$) { #We shouldn't still be alive, try to send as much detail to parent as possible as to why
                #           my $error= "$modname plugin bug, pid $$, process description: '$$progname'";
                #           if ($@) {
                #               $error .= " with error '$@'";
                #           } else { #Sys::Virt and perhaps Net::SNMP sometimes crashes in a way $@ won't catch..
                #               $error .= " with missing eval error, probably due to special manipulation of $@ or strange circumstances in an XS library, remove evals in xcatd marked 'REMOVEEVALFORDEBUG and run xcatd -f for more info";
                #           }
                #           if (scalar (@nodes)) { #Don't know which of the nodes, so one error message warning about the possibliity..
                #               $error .= " while trying to fulfill request for the following nodes: ".join(",",@nodes);
                #           }
                #           xCAT::MsgUtils->message("S","xcatd: $error");
                #           $callback->({error=>[$error],errorcode=>[1]});
                #           xexit(0); #Die like we should have done
                #       } elsif ($@) { #We are still alive, should be alive, but yet we have an error.  This means we are in the case of 'do_request' or something similar.  Forward up the death since our communication channel is intact..
                #           die $@;
                #       }
                #     } else {
                #       $plugin_children{$child}=1;
                #       close $parfd;
                #       $check_fds->add($pfd);
                #     }
            } else {
                my $pm_name = $plugins_dir . "/" . $modname . ".pm";
                foreach my $node (keys %{ $handler_hash{$_} }) {
                    if ($sock) {
                        print $sock XMLout({ node => [ { name => [$node], data => ["Cannot find the perl module to complete the operation: $pm_name"], errorcode => [1] } ] }, NoAttr => 1, RootName => 'xcatresponse');
                    } else {
                        $callback->({ node => [ { name => [$node], data => ["Cannot find the perl module to complete the operation: $pm_name"], errorcode => [1] } ] });
                    }
                }
            }
        }
        unless ($sock) { return $Main::resps }

        # while (($plugin_numchildren > 0) and ($check_fds->count > 0)) { #this tracks end of useful data from children much more closely
        #   relay_fds($check_fds,$sock);
        # }
        # #while (relay_fds($check_fds,$sock)) {}
        # my %done;
        # $done{serverdone} = {};
        # if ($req->{transid}) {
        #   $done{transid}=$req->{transid}->[0];
        # }
        # if ($sock) {
        #     my $clientpresence = new IO::Select; #The client may have gone away without confirmation, don't PIPE over this trivial thing
        #     $clientpresence->add($sock);
        #     if ($clientpresence->can_write(5)) {
        #         print $sock XMLout(\%done,RootName => 'xcatresponse',NoAttr=>1);
        #     }
        # }
    }




###################################
    # dispatch_request
    #    dispatch the requested command
    #
    # NOTE:  This is copied from xcatd (last merge 11/23/09).
    #        All we really need from this subroutine is to call preprocess_request
    #        and to only run the command for nodes handled by the local server
    #        Will eventually move to using common source....
###################################
    sub dispatch_request {

        #  %dispatched_children=();
        require xCAT::Utils;
        my $req = shift;
        $dispatch_cb = shift;

        my $modname = shift;
        my $reqs    = [];

        #  my $child_fdset = new IO::Select;
        no strict "refs";

        #Hierarchy support.  Originally, the default scope for noderange commands was
        #going to be the servicenode associated unless overriden.
        #However, assume for example that you have blades and a blade is the service node
        #rpower being executed by the servicenode for one of its subnodes would have to
        #reach it's own management module.  This has the potential to be non-trivial for some quite possible network configurations.
        #Since plugins may commonly experience this, a preprocess_request implementation
        #will for now be required for a command to be scaled through service nodes
        #If the plugin offers a preprocess method, use it to set the request array
        if (defined(${ "xCAT_plugin::" . $modname . "::" }{preprocess_request})) {
            $SIG{CHLD} = 'DEFAULT';
            $reqs = ${ "xCAT_plugin::" . $modname . "::" }{preprocess_request}->($req, $dispatch_cb, \&do_request);
        } else {    #otherwise, pass it in without hierarchy support
            $reqs = [$req];
        }

        # $dispatch_children=0;
        # $SIG{CHLD} = \&dispatch_reaper; #sub {my $cpid; while (($cpid =waitpid(-1, WNOHANG)) > 0) { if ($dispatched_children{$cpid}) { delete $dispatched_children{$cpid}; $dispatch_children--; } } };
        my $onlyone = 0;
        if (defined $reqs and (scalar(@{$reqs}) == 1)) {
            $onlyone = 1;
        }

        foreach (@{$reqs}) {

            #   my $pfd;
            #   my $parfd; #use a private variable so it won't trounce itself recursively
            #   my $child;
            delete $_->{noderange};

            #----- added to Client.pm -----#
            if ($_->{node}) {
                $_->{noderange}->[0] = join(',', @{ $_->{node} });
            }

            #----- end added to Client.pm -----#

            if (ref $_->{'_xcatdest'} and (ref $_->{'_xcatdest'}) eq 'ARRAY') {
                $_->{'_xcatdest'} = $_->{'_xcatdest'}->[0];
            }
            if ($onlyone and not($_->{'_xcatdest'} and xCAT::NetworkUtils->thishostisnot($_->{'_xcatdest'}))) {
                $SIG{CHLD} = 'DEFAULT';
                ${ "xCAT_plugin::" . $modname . "::" }{process_request}->($_, $dispatch_cb, \&do_request);
                return;
            }

            #   socketpair($pfd, $parfd,AF_UNIX,SOCK_STREAM,PF_UNSPEC) or die "socketpair: $!";
            #   $parfd->autoflush(1);
            #   $pfd->autoflush(1);
            #   $child = xCAT::Utils->xfork;
            #   if ($child) {
            #      $dispatch_children++;
            #      $dispatched_children{$child}=1;
            #      $child_fdset->add($pfd);
            #      next;
            #   }
            #   unless (defined $child) {
            #      $dispatch_cb->({error=>['Fork failure dispatching request'],errorcode=>[1]});
            #   }
            #   undef $SIG{CHLD};
            #     $dispatch_parentfd = $parfd;
            my @prexcatdests = ();
            my @xcatdests    = ();
            if (ref($_->{'_xcatdest'}) eq 'ARRAY') { #If array, consider it an 'anycast' operation, broadcast done through dupe
                    #requests, or an alternative join '&' maybe?
                @prexcatdests = @{ $_->{'_xcatdest'} };
            } else {
                @prexcatdests = ($_->{'_xcatdest'});
            }
            foreach (@prexcatdests) {
                if ($_ and /,/) {
                    push @xcatdests, split /,/, $_;
                } else {
                    push @xcatdests, $_;
                }
            }
            my $xcatdest;
            my $numdests          = scalar(@xcatdests);
            my $request_satisfied = 0;
            foreach $xcatdest (@xcatdests) {
                my $dlock;
                if ($xcatdest and xCAT::NetworkUtils->thishostisnot($xcatdest)) {

                    #----- added to Client.pm -----#
                    $dispatch_cb->({ warning => [ 'XCATBYPASS is set, skipping hierarchy call to ' . $_->{'_xcatdest'} . '' ] });

                    #----- end added to Client.pm -----#

                    #           #mkpath("/var/lock/xcat/"); #For now, limit intra-xCAT requests to one at a time, to mitigate DB handle usage
                    #           #open($dlock,">","/var/lock/xcat/dispatchto_$xcatdest");
                    #           #flock($dlock,LOCK_EX);
                    #           $ENV{XCATHOST} =  ($xcatdest =~ /:/ ? $xcatdest : $xcatdest.":3001" );
                    #           $$progname.=": connection to ".$ENV{XCATHOST};
                    #           my $errstr;
                    #           eval {
                    #           undef $_->{'_xcatdest'};
                    #           xCAT::Client::submit_request($_,\&dispatch_callback,$xcatdir."/cert/server-cred.pem",$xcatdir."/cert/server-cred.pem",$xcatdir."/cert/ca.pem");
                    #           };
                    #           if ($@) {
                    #            $errstr=$@;
                    #           }
                    #           #unlink("/var/lock/xcat/dispatchto_$xcatdest");
                    #           #flock($dlock,LOCK_UN);
                    #           if ($errstr) {
                    #                   if ($numdests == 1) {
                    #                   dispatch_callback({error=>["Unable to dispatch command to ".$ENV{XCATHOST}.", command will not make changes to that server ($errstr)"],errorcode=>[1]});
                    #                       xCAT::MsgUtils->message("S","Error dispatching request to ".$ENV{XCATHOST}.": ".$errstr);
                    #               } else {
                    #                       xCAT::MsgUtils->message("S","Error dispatching request to ".$ENV{XCATHOST}.", trying other service nodes: ".$errstr);
                    #               }
                    #               next;
                    #               } else {
                    #               $request_satisfied=1;
                    #               last;
                    #           }
                } else {
                    $$progname .= ": locally executing";
                    $SIG{CHLD} = 'DEFAULT';

                    #           ${"xCAT_plugin::".$modname."::"}{process_request}->($_,\&dispatch_callback,\&do_request);
                    #----- changed in Client.pm -----#
                    ${ "xCAT_plugin::" . $modname . "::" }{process_request}->($_, $dispatch_cb, \&do_request);

                    #----- end changed in Client.pm -----#
                    last;
                }
            }

            #    if ($numdests > 1 and not $request_satisfied) {
            #           xCAT::MsgUtils->message("S","Error dispatching a request to all possible service nodes for request");
            #       dispatch_callback({error=>["Failed to dispatch command to any of the following service nodes: ".join(",",@xcatdests)],errorcode=>[1]});
            #    }

            #    xexit;
        }

        #while (($dispatch_children > 0) and ($child_fdset->count > 0)) { relay_dispatch($child_fdset) }
        #while (relay_dispatch($child_fdset)) { } #Potentially useless drain.
    }



###################################
    # do_request
    #    called from a plugin to execute another xCAT plugin command internally
    #
    # NOTE:  This is copied from xcatd (last merge 11/23/09).
    #        Will eventually move to using common source....
###################################
    sub do_request {
        my $req        = shift;
        my $second     = shift;
        my $rsphandler = \&build_response;
        my $sock       = undef;
        if ($second) {
            if (ref($second) eq "CODE") {
                $rsphandler = $second;
            } elsif (ref($second) eq "GLOB") {
                $sock = $second;
            }
        }

        #my $sock = shift; #If no sock, will return a response hash
        if ($cmd_handlers{ $req->{command}->[0] }) {
            return plugin_command($req, $sock, $rsphandler);
        } elsif ($req->{command}->[0] eq "noderange" and $req->{noderange}) {
            my @nodes = xCAT::NodeRange::noderange($req->{noderange}->[0]);
            my %resp;
            if (xCAT::NodeRange::nodesmissed()) {
                $resp{warning} = "Invalid nodes in noderange:" . join ',', xCAT::NodeRange::nodesmissed() . "\n";
            }
            $resp{serverdone} = {};
            @{ $resp{node} } = @nodes;
            if ($req->{transid}) {
                $resp{transid} = $req->{transid}->[0];
            }
            if ($sock) {
                print $sock XMLout(\%resp, RootName => 'xcatresponse', NoAttr => 1);
            } else {
                return (\%resp);
            }
        } else {
            my %resp = (error => "Unsupported request");
            $resp{serverdone} = {};
            if ($req->{transid}) {
                $resp{transid} = $req->{transid}->[0];
            }
            if ($sock) {
                print $sock XMLout(\%resp, RootName => 'xcatresponse', NoAttr => 1);
            } else {
                return (\%resp);
            }
        }
    }


###################################
    # build_response
    #   This callback handles responses from nested level plugin calls.
    #   It builds a merged hash of all responses that gets passed back
    #   to the calling plugin.
    #   Note:  Need to create a "deep clone" of this response to add to the
    #     return, otherwise next time through the referenced data is overwritten
    #
###################################
    sub build_response {
        my $rsp = shift;
        require Storable;
        foreach (keys %$rsp) {
            my $subresp = Storable::dclone($rsp->{$_});
            push(@{ $Main::resps->{$_} }, @{$subresp});
        }
    }



}    # end of submit_request()

####################################
# populates all the site attributes into %::XCATSITEVALS
# This is used with XCATBYPASS=1
###################################
sub populate_site_hash {
    %::XCATSITEVALS = ();
    my $sitetab = xCAT::Table->new('site', -create => 0);
    unless ($sitetab) {
        print("ERROR: Unable to open basic site table for configuration\n");
        return;
    }
    my @records = $sitetab->getAllAttribs(qw/key value/);
    foreach (@records) {
        $::XCATSITEVALS{ $_->{key} } = $_->{value};
    }
}



##########################################
# handle_response is a default callback that can be passed into submit_request()
# It is invoked repeatedly by submit_request() to print out the data returned by
# the plugin.
#
# The normal flow is:
#	-> client cmd (e.g. nodels, which is just a link to xcatclient)
#		-> xcatclient
#			-> submit_request()
#				-> send xml request to xcatd
#					-> xcatd
#						-> process_request() of the plugin
#						<- plugin callback
#					<- xcatd
#				<- xcatd sends xml response to client
#			<- submit_request() read response
#		<- handle_response() prints responses and saves exit codes
#	<- xcatclient gets exit code and exits
#
# But in XCATBYPASS mode, the flow is:
#	-> client cmd (e.g. nodels, which is just a link to xcatclient)
#		-> xcatclient
#			-> submit_request()
#				-> process_request() of the plugin
#		<- handle_response() prints responses and saves exit codes
#	<- xcatclient gets exit code and exits
#
# Format of the response hash:
#  {data => [ 'data str1', 'data str2', '...' ] }
#
#    Results are printed as:
#       data str1
#       data str2
#
# or:
#  {data => [ {desc => [ 'desc1' ],
#              contents => [ 'contents1' ] },
#             {desc => [ 'desc2 ],
#              contents => [ 'contents2' ] }
#                :
#            ] }
#    NOTE:  In this format, only the data array can have more than one
#           element. All other arrays are assumed to be a single element.
#    Results are printed as:
#       desc1: contents1
#       desc2: contents2
#
# or:
#  {node => [ {name => ['node1'],
#              data => [ {desc => [ 'node1 desc' ],
#                         contents => [ 'node1 contents' ] } ] },
#             {name => ['node2'],
#              data => [ {desc => [ 'node2 desc' ],
#                         contents => [ 'node2 contents' ] } ] },
#                :
#             ] }
#    NOTE:  Only the node array can have more than one element.
#           All other arrays are assumed to be a single element.
#
#    This was generated from the corresponding XML:
#    <xcatrequest>
#      <node>
#        <name>node1</name>
#        <data>
#          <desc>node1 desc</desc>
#          <contents>node1 contents</contents>
#        </data>
#      </node>
#      <node>
#        <name>node2</name>
#        <data>
#          <desc>node2 desc</desc>
#          <contents>node2 contents</contents>
#        </data>
#      </node>
#    </xcatrequest>
#
#   Results are printed as:
#      node_name: desc: contents
##########################################
sub handle_response {
    my $rsp = shift;
    if ($ENV{'XCATSHOWXML'}) {
        my $xmlrec = XMLout($rsp, RootName => 'xcatresponse', NoAttr => 1, KeyAttr => []);
        print "$xmlrec\n";
        return;
    }

    my $msgsource = "";
    $msgsource = $rsp->{xcatdsource}->[0] if ($rsp->{xcatdsource});

    # To determine if the INFO msg need to be added with source server name. For ERROR/WARN, it always is shown.
    my $showsource = 0;
    if ($rsp->{host}) {
        $showsource = 1;
    }
    if ($ENV{'XCATSHOWSVR'}) {
        unless ($rsp->{NoSvrPrefix}) { # some plugins could disable the prefix forcely by seting the flag in response.
            $showsource = 1;
        }
    }

    #print "in handle_response\n";
    # Handle errors
    if (defined($rsp->{errorcode})) {
        if (ref($rsp->{errorcode}) eq 'ARRAY') {
            foreach my $ecode (@{ $rsp->{errorcode} }) {
                $xCAT::Client::EXITCODE |= $ecode;
            }
        }
        else {
            $xCAT::Client::EXITCODE |= $rsp->{errorcode};
        }    # assume it is a non-reference scalar
    }

    if ($rsp->{error}) {

        #print "printing error\n";
        if (ref($rsp->{error}) eq 'ARRAY') {
            foreach my $text (@{ $rsp->{error} }) {
                my $desc = "$text";
                $desc = "[$msgsource]: $desc" if ($desc && $msgsource);
                $desc = "Error: $desc" unless ($rsp->{NoErrorPrefix});
                print STDERR "$desc\n";
            }
        }
        else {
            my $desc = $rsp->{error};
            $desc = "[$msgsource]: $desc" if ($desc && $msgsource);
            $desc = "Error: $desc" unless ($rsp->{NoErrorPrefix});
            print STDERR "$desc\n";
        }
    }
    if ($rsp->{warning}) {

        #print "printing warning\n";
        if (ref($rsp->{warning}) eq 'ARRAY') {
            foreach my $text (@{ $rsp->{warning} }) {
                my $desc = "$text";
                $desc = "[$msgsource]: $desc" if ($desc && $msgsource);
                $desc = "Warning: $desc" unless ($rsp->{NoWarnPrefix});
                print STDERR "$desc\n";
            }
        }
        else {
            my $desc = $rsp->{warning};
            $desc = "[$msgsource]: $desc" if ($desc && $msgsource);
            $desc = "Warning: $desc" unless ($rsp->{NoWarnPrefix});
            print STDERR "$desc\n";
        }
    }
    if ($rsp->{info}) {
        #print "printing info\n";
        if (ref($rsp->{info}) eq 'ARRAY') {
            foreach my $text (@{ $rsp->{info} }) {
                my $desc = "$text";
                $desc = "[$msgsource]: $desc" if ($showsource && $desc && $msgsource);
                print "$desc\n";
            }
        }
        else {
            my $desc = $rsp->{info};
            $desc = "[$msgsource]: $desc" if ($showsource && $desc && $msgsource);
            print "$desc\n";
        }
    }

    if ($rsp->{sinfo}) {
        if (ref($rsp->{sinfo}) eq 'ARRAY') {
            foreach my $text (@{ $rsp->{sinfo} }) {
                print "$text\r"; $|++;
            }
        }
        else {
            print($rsp->{sinfo} . "\r"); $|++;
        }
    }



    # Handle {node} structure
    my $errflg = 0;
    my $nodes  = ($rsp->{node});
    unless (ref $nodes eq 'ARRAY') {
        $nodes = [$nodes];
    }
    if (scalar @{$nodes}) {

        #print "printing node\n";
        my $node;
        foreach $node (@$nodes) {
            my $desc;
            if (ref($node->{name}) eq 'ARRAY') {
                $desc = $node->{name}->[0];
            } else {
                $desc = $node->{name};
            }

            if ($node->{errorcode}) {
                if (ref($node->{errorcode}) eq 'ARRAY') {
                    foreach my $ecode (@{ $node->{errorcode} }) {
                        $xCAT::Client::EXITCODE |= $ecode;
                    }
                }
                else {
                    $xCAT::Client::EXITCODE |= $node->{errorcode};
                }    # assume it is a non-reference scalar
            }
            if ($node->{error}) {
                if ($desc) {
                    $desc = "$desc: [$msgsource]" if ($msgsource);
                } else {
                    $desc = "[$msgsource]" if ($msgsource);
                }
                $desc .= ": Error: " . $node->{error}->[0];
                $errflg = 1;
            }
            if ($node->{warning}) {
                if ($desc) {
                    $desc = "$desc: [$msgsource]" if ($msgsource);
                } else {
                    $desc = "[$msgsource]" if ($msgsource);
                }
                $desc .= ": Warning: " . $node->{warning}->[0];
                $errflg = 1;
            }
            if ($node->{data}) {
                if ($desc) {
                    $desc = "$desc: [$msgsource]" if ($showsource && $msgsource);
                } else {
                    $desc = "[$msgsource]" if ($showsource && $msgsource);
                }
                if (ref(\($node->{data})) eq 'SCALAR') {
                    $desc = $desc . ": " . $node->{data};
                } elsif (ref($node->{data}) eq 'HASH') {
                    if ($node->{data}->{desc}) {
                        if (ref($node->{data}->{desc}) eq 'ARRAY') {
                            $desc = $desc . ": " . $node->{data}->{desc}->[0];
                        } else {
                            $desc = $desc . ": " . $node->{data}->{desc};
                        }
                    }
                    if ($node->{data}->{contents}) {
                        if (ref($node->{data}->{contents}) eq 'ARRAY') {
                            $desc = "$desc: " . $node->{data}->{contents}->[0];
                        } else {
                            $desc = "$desc: " . $node->{data}->{contents};
                        }
                    }
                } elsif (ref(\($node->{data}->[0])) eq 'SCALAR') {
                    $desc = $desc . ": " . $node->{data}->[0];
                } else {
                    if ($node->{data}->[0]->{desc}) {
                        $desc = $desc . ": " . $node->{data}->[0]->{desc}->[0];
                    }
                    if ($node->{data}->[0]->{contents}) {
                        $desc = "$desc: " . $node->{data}->[0]->{contents}->[0];
                    }
                }
            }
            if ($node->{base64_data}) {
                $desc = $desc . ": " . decode_base64($node->{base64_data}->[0]);
            }
            if ($desc && $desc ne "[$msgsource]") {
                if ($errflg == 1) {
                    print STDERR ("$desc\n");
                } else {
                    print "$desc\n";
                }
            }
        }
    }

    # Handle {data} structure with no nodes
    if ($rsp->{data}) {

        #print "printing data\n";
        my $data = ($rsp->{data});
        my $data_entry;
        foreach $data_entry (@$data) {
            my $desc;
            if (ref(\($data_entry)) eq 'SCALAR') {
                $desc = $data_entry;
            } else {
                if ($data_entry->{desc}) {
                    $desc = $data_entry->{desc}->[0];
                }
                if ($data_entry->{contents}) {
                    if ($desc) {
                        $desc = "$desc: " . $data_entry->{contents}->[0];
                    } else {
                        $desc = $data_entry->{contents}->[0];
                    }
                }
            }
            if ($desc) {
                $desc = "[$msgsource]: $desc" if ($showsource && $msgsource);
                print "$desc\n";
            }
        }
    }
}    # end of handle_response