eval '(exit $?0)' && eval 'PERL=`which perl5`; exec $PERL -wS $0 ${1+"$@"}'
& eval 'setenv PERL `which perl5`; exec $PERL -wS $0 $argv:q'
if 0;
### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
#
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines
# identifies the rest of the file as PERL for EMACS autoformatting.
# See end of copyright for more information.
#
#
# -------------------------------------------------------------------
# X-BONE
#
# http://www.isi.edu/xbone
# USC Information Sciences Institute (USC/ISI)
# Marina del Rey, California 90292, USA
# Copyright (c) 1998-2005
#
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute. The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
#
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
# $RCSfile: xb-api-client.pl,v $
#
# $Revision: 1.27 $
# $Author: pingali $
# $Date: 2005/04/08 19:19:56 $
# $State: Exp $
# ----------------------------------------------------------------------------
# The first lines start PERL on any system where perl is in the path.
# This is a modified version of the "start perl" script provided in
# the PERL man pages, which starts perl on the remainder of the file
# regardless of whether it is run under sh, csh, or perl.
#
# This version is modified to dynamically locate the perl path, rather
# than requiring it be hard-coded.
# set library search path
BEGIN {
use strict;
use sigtrap;
use FindBin;
use Config;
delete $ENV{PATH};
my $version = $Config{'version'};
my $arch = $Config{'archname'};
my $ldir = $FindBin::RealBin;
foreach my $p ($ldir,
"$ldir/modules",
"$ldir/modules/cpan",
"$ldir/modules/cpan/lib/perl5/$version",
"$ldir/modules/cpan/lib/perl5/$version/$arch",
"$ldir/modules/cpan/lib/perl5/site_perl/mach",
"$ldir/modules/cpan/lib/perl5/site_perl/mach/$arch",
"$ldir/modules/cpan/lib/perl5/site_perl/$version",
"$ldir/modules/cpan/lib/perl5/site_perl/$version/$arch",
"$ldir/modules/cpan/lib/perl5/site_perl/$version/mach",
"$ldir/modules/cpan/lib/perl5/site_perl/$version/mach/$arch",
) {
if(-d $p) { unshift @INC, $p; }
}
# untaint the resulting include path so "use" works
foreach my $i (@INC) { if($i =~ /(.*)/) { $i = $1;} }
};
##############################################################################
# END OF PREFIX - PUT YOUR PERL CODE BELOW #
##############################################################################
# Primary Author: Yu-Shun Wang
# Description: This is a simple text-based XBone API client for XBone.
use strict;
use Data::Dumper;
use IO::Select;
use IO::Socket::SSL;
use Socket;
use Socket6;
use IO::Socket::SSLv6;
use XB_API_parser;
use XB_API_SUBS;
use XB_Params;
use XB_API_GUI;
use XB_XML_GUI;
use XB_XML_scan;
my $use_xml = 1;
$Data::Dumper::Indent = 1;
my $api_parser = XB_API_parser->new;
my %client_params = (
"node_cert" => $XB_Params::node_cert,
"node_key" => $XB_Params::node_key,
"ca_cert" => $XB_Params::ca_cert,
"ca_path" => $XB_Params::ca_path
);
my %app_ex1 = (
"program" => 'app-ex1',
"script" => 'http://www.isi.edu/~pingali/sample-app-deploy-script.sh',
"checksum" => '6e0323f0b00fb9863ef2f7ba9924b4c8',
"suid" => 'nobody',
"nodes" => 'all',
"ifaces" => 'all'
);
my %app_ex2 = (
"program" => 'app-ex2',
"script" => 'http://www.isi.edu/~pingali/sample-app-deploy-script.sh',
"checksum" => '6e0323f0b00fb9863ef2f7ba9924b4c8',
"suid" => 'nobody',
"nodes" => 'all',
"ifaces" => 'all'
);
my %app_args;
$app_args{$app_ex1{program}} = \%app_ex1;
$app_args{$app_ex2{program}} = \%app_ex2;
my %cmd_args = (
# auth/credential info
"auth_type" => 'X509',
"user_name" => 'Yu-Shun Wang',
"user_email" => 'yushunwa@isi.edu',
# create properties
"search_radius" => 5,
"manager" => "tnn.isi.edu",
"manager_port" => $XB_Params::xbone_api_port,
# overlay properties
"topology" => 'star',
"overlay_name" => 'test.' . $XB_Params::XBONE_NET,
"hosts" => 5,
"host_os" => 'freebsd',
"routers" => 1,
"router_os" => 'freebsd',
"dns" => 'no',
"IPsec_authentication" => 'none',
"IPsec_encryption" => 'none',
"dynamic_routing" => 'no',
"address_type" => 'ipv4',
# misc
"name_server" => undef,
"name_server_port" => undef,
"address_server" => undef,
"address_server_port" => undef,
"application" => \%app_args,
"dummynet" => 'no',
"dummynet_bandwidth" => 30,
"dummynet_bandwidth_unit" => 'Mbit/s',
"dummynet_delay" => 25,
"dummynet_queue" => "100",
"dummynet_queue_unit" => "slots",
"dummynet_loss_rate" => 0.02,
"custom_netlist" => "able xray baker xray able baker",
);
# Missing parameters:
# - routing="static"|"dynamic" to replace "dynamic_routing"
# - host_os
#
# Extra parameters
# - 'os' => 'FreeBSD Linux',
# - 'ip_address' => '10.2.43.122',
# - 'local_ip_address' => '10.2.43.122',
# - 'remote_ip_address' => '1:2344:ab34:34',
# - 'application' => 'program name',
# - 'application_script' => 'script for application program',
# - 'custom_netlist' =>
# 'able xray baker xray charlie xray xray zero dog zero easy zero'
# == define some recursive overlays for testing ===============================
my $r0 = "
(xbone 1.5 2.0 (credential (user_name 'Yu-Shun Wang')
(user_email yushunwa\@isi.edu) (auth_type x509))
(create_overlay (search_radius 5)
(xol 1.1
(class 3Line
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node a (nodeprops )
(interfaces (interface left) (interface right) ))
(node c (nodeprops )
(interfaces (interface left) (interface right) )))
(linklist (link link0))
(netlist (a.right link0 c.left))
(exportlist (a.left) (c.right) ))
(class 3LineRing
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node X: 3Line (nodeprops ))
(node d (nodeprops )
(interfaces (interface left) (interface right))))
(linklist (link link0) (link link1))
(netlist (X.left link0 d.right) (X.right link1 d.left) )
(exportlist ))
(root 3LineRing foobar)
)))\n";
my $r1 = "
(xbone 1.5 2.0 (credential (user_name 'Yu-Shun Wang')
(user_email yushunwa\@isi.edu) (auth_type x509))
(create_overlay (search_radius 5)
(xol 1.1
(class 3Line
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node a (nodeprops )
(interfaces (interface left) (interface right) ))
(node c (nodeprops )
(interfaces (interface left) (interface right) )))
(linklist (link link0))
(netlist (a.right link0 c.left))
(exportlist (a.left) (c.right) ))
(class 3LineRing
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node X: 3Line (nodeprops ))
(node Y: 3Line (nodeprops )))
(linklist (link link0) (link link1))
(netlist (X.left link0 Y.right) (X.right link1 Y.left) )
(exportlist ))
(root 3LineRing foobar)
)))\n";
my $r2 = "
(xbone 1.5 2.0 (credential (user_name 'Yu-Shun Wang')
(user_email yushunwa\@isi.edu) (auth_type x509) )
(create_overlay (search_radius 5)
(xol 1.1
(class star
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node host_0 (nodeprops (os freebsd|kame) )
(interfaces (interface if_0) (interface ext0)))
(node host_1 (nodeprops (os freebsd|kame) )
(interfaces (interface if_0) (interface ext1)))
(node router_0 (nodeprops (os linux|kame) )
(interfaces (interface if_0) (interface if_1))))
(linklist (link link_0) (link link_1))
(netlist (host_0.if_0 link_0 router_0.if_0)
(host_1.if_0 link_1 router_0.if_1))
(exportlist (host_0.ext0) (host_1.ext1) ))
(class 3Line
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node a: star (nodeprops ))
(node b (nodeprops )
(interfaces (interface left) (interface right) ))
(node c: star (nodeprops )))
(linklist (link link0) (link link1))
(netlist (a.ext0 link0 b.left) (b.right link1 c.ext1) )
(exportlist (a.ext1) (c.ext0) ))
(class 3LineRing
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node X: 3Line (nodeprops ))
(node Y: 3Line (nodeprops )))
(linklist (link link0) (link link1))
(netlist (X.ext1 link0 Y.ext0) (X.ext0 link1 Y.ext1) )
(exportlist ))
(root 3LineRing foobar)
)))\n";
my $r3 = "
(xbone 1.5 2.0 (credential (user_name 'Yu-Shun Wang')
(user_email yushunwa\@isi.edu) (auth_type x509) )
(create_overlay (search_radius 5)
(xol 1.1
(class star
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node host_0 (nodeprops (os freebsd|kame) )
(interfaces (interface if_0) (interface ext0)))
(node host_1 (nodeprops (os freebsd|kame) )
(interfaces (interface if_0) (interface ext1)))
(node router_0 (nodeprops (os linux|kame) )
(interfaces (interface if_0) (interface if_1))))
(linklist (link link_0) (link link_1))
(netlist (host_0.if_0 link_0 router_0.if_0)
(host_1.if_0 link_1 router_0.if_1))
(exportlist (host_0.ext0) (host_1.ext1) ))
(class Line
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node a: star (nodeprops ))
(node b (nodeprops )
(interfaces (interface left) (interface right) ))
(node c (nodeprops ) (interfaces (interface if)))
(node d (nodeprops ) (interfaces (interface if))) )
(linklist (link link0) (link link1) (link link2))
(netlist (a.ext0 link0 d.if)
(a.ext1 link1 b.left)
(b.right link2 c.if) )
(exportlist ))
(root Line foobar)
)))\n";
my $r4 = "
(xbone 1.5 2.0 (credential (user_name 'Yu-Shun Wang')
(user_email yushunwa\@isi.edu) (auth_type x509) )
(create_overlay (search_radius 5)
(xol 1.1
(class star
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node host_0 (nodeprops (os freebsd|kame) )
(interfaces (interface if_0) (interface ext0)))
(node host_1 (nodeprops (os freebsd|kame) )
(interfaces (interface if_0) (interface ext1)))
(node router_0 (nodeprops (os linux|kame) )
(interfaces (interface if_0) (interface if_1))))
(linklist (link link_0) (link link_1))
(netlist (host_0.if_0 link_0 router_0.if_0)
(host_1.if_0 link_1 router_0.if_1))
(exportlist (host_0.ext0) (host_1.ext1) ))
(class Line
(netprops (IPsec_authentication none) (IPsec_encryption none)
(dns yes) (dynamic_routing no) (addresstype ipv4))
(nodelist (node a: star (nodeprops ))
(node b (nodeprops ) (interfaces (interface left)))
(node d (nodeprops ) (interfaces (interface if))) )
(linklist (link link0) (link link1))
(netlist (a.ext0 link0 d.if)
(a.ext1 link1 b.left) )
(exportlist ))
(root Line foobar)
)))\n";
my ($cmd, $name, $topo, $topology, $host, $router, $msg_ref, $api_cmd);
my ($peer, $sock, $ldap);
# == Main =====================================================================
my $noargs = $#ARGV;
if(($#ARGV +1)){
$peer = shift @ARGV;
}else{
chomp($peer = `hostname`);
}
print "--> Overlay Manager = $peer\n";
print " CAcert: $client_params{ca_cert}\n";
print " CApath: $client_params{ca_path}\n";
print " Cert: $client_params{node_cert}\n";
print " Key: $client_params{node_key}\n";
$IO::Socket::SSL::DEBUG = 0;
foreach my $name (keys %client_params){
unless (-e $client_params{$name}){
print "File not found! Please check \$XB_Params::$name in ".
"/usr/local/xbone/programs/XB_Params.pm\n";
exit 1;
};
}
while(1){
# main menu
print "--> Command: [C=Create D=Delete L=List S=Status F=Discover Q=Quit] ";
chomp ($cmd = <>);
# generate corresponding API command message:
if($cmd =~ /c/i){
print " + [Create] Enter overlay name: ";
chomp ($name = <>);
$cmd_args{overlay_name} = $name. ".$XB_Params::XBONE_NET";
# obtain LDAP
while ((not defined $ldap) or ($ldap !~ /(yes|no)/)) {
print " + [Create] Use LDAP?: ";
chomp ($ldap = <>);
$cmd_args{ldap} = $ldap;
$cmd_args{attrvals} = "";
$cmd_args{scope} = "local";
}
#
print " + [Create] Enter overlay topology [s=star; l=linear; r=ring; c=custom\n";
print " m=recursive; i=imported (not yet supported)]: ";
chomp ($topo = <>);
if($topo =~ /s/i){
print " + [Create] Star - how many hosts: ";
chomp($host = <>);
unless($host =~ /\d+/){
print " ! [Create] $host is not a number!\n";
next;
}
$cmd_args{topology} = "star";
$cmd_args{hosts} = $host;
$cmd_args{routers} = 1;
if($use_xml){
$msg_ref = XB_XML_GUI::XB_build_create_overlay_msg (\%cmd_args);
}else{
$msg_ref = XB_API_GUI::XB_build_create_overlay_msg (\%cmd_args);
}
print "$$msg_ref\n";
}elsif($topo =~ /(l|r)/i){
$cmd_args{topology} = ($1 =~ /l/i)? "linear":"ring";
print " + [Create] Linear - how many routers: ";
chomp($router = <>);
unless($router =~ /\d+/){
print " ! [Create] $router is not a number!\n";
next;
}
print " + [Create] Linear - how many hosts: ";
chomp($host = <>);
unless($host =~ /\d+/){
print " ! [Create] $host is not a number!\n";
next;
}
$cmd_args{hosts} = $host;
$cmd_args{routers} = $router;
if($use_xml){
$msg_ref = XB_XML_GUI::XB_build_create_overlay_msg (\%cmd_args);
}else{
$msg_ref = XB_API_GUI::XB_build_create_overlay_msg (\%cmd_args);
}
print "$$msg_ref\n";
} elsif($topo =~ /c/i){
print " + [Create] Custom - (linear) how many hosts: ";
chomp($host = <>);
unless($host =~ /\d+/){
print " ! [Create] $host is not a number!\n";
next;
}
$cmd_args{topology} = "custom";
$cmd_args{hosts} = 0;
$cmd_args{routers} = $host;
$cmd_args{custom_netlist} = "";
foreach my $i (1..($host-1)){
my $next;
if ($i == $host){
$next = 1;
} else {
$next = $i+1;
}
$cmd_args{custom_netlist} .= "test$i test$next\n";
}
if($use_xml){
$msg_ref = XB_XML_GUI::XB_build_create_overlay_msg (\%cmd_args);
}else{
$msg_ref = XB_API_GUI::XB_build_create_overlay_msg (\%cmd_args);
}
print "$$msg_ref\n";
}elsif($topo =~ /m/i){
print " + [Create] Recursive - choose from the following:\n";
print " 0: 3 nodes (1 meta node w/2, 1 simple node)\n";
print " 1: 4 nodes (2 meta nodes w/2 each)\n";
print " 2: 6 nodes (2 meta nodes w/3 each)\n";
print " 3: 7 nodes (1 meta node w/3)\n";
print " 4: 6 nodes (1 meta node w/3): ";
chomp($router = <>);
$_ = $router;
my $realmsg;
SWITCH: {
/0/ && do { $realmsg = $r0; last SWITCH; };
/1/ && do { $realmsg = $r1; last SWITCH; };
/2/ && do { $realmsg = $r2; last SWTICH; };
/3/ && do { $realmsg = $r3; last SWITCH; };
/4/ && do { $realmsg = $r4; last SWITCH; };
print " ! [Create] $router invalid; only 0, 1, 2, 3\n";
next;
}
$realmsg =~ s/foobar/$name\.xbone\.net/g;
$msg_ref = \$realmsg;
print "$$msg_ref\n";
}elsif($topo =~ /i/i){
print " + [Create] Import from file: NOT YET!\n";
next;
}else{
print " + [Create] Unknown topology: $topo\n";
next;
}
}elsif($cmd =~ /d/i){
print " - [Delete] Enter name of the overlay: ";
chomp ($name = <>);
$cmd_args{overlay_name} = $name. ".$XB_Params::XBONE_NET";
$msg_ref = XB_XML_GUI::XB_build_destroy_overlay_msg (\%cmd_args);
print "$$msg_ref\n";
}elsif($cmd =~ /l/i){
print " - [List] List all active overlays:\n";
$msg_ref = XB_XML_GUI::XB_build_list_overlays_msg (\%cmd_args);
print "$$msg_ref\n";
}elsif($cmd =~ /f/i){
print " - [Discover] Discover all active nodes:\n";
# obtain LDAP
while ((not defined $ldap) or ($ldap !~ /(yes|no)/)) {
print " + [Create] Use LDAP?: ";
chomp ($ldap = <>);
$cmd_args{ldap} = $ldap;
$cmd_args{attrvals} = "";
$cmd_args{scope} = "local";
}
# construct the xml message to be sent to the backend
$msg_ref = XB_XML_GUI::XB_build_discover_daemons_msg (\%cmd_args);
print "$$msg_ref\n";
}elsif($cmd =~ /s/i){
print " - [Status] Show the node/link status of an overlay; Name: ";
chomp ($name = <>);
$cmd_args{overlay_name} = $name. ".$XB_Params::XBONE_NET";
$msg_ref = XB_XML_GUI::XB_build_overlay_status_msg(\%cmd_args);
print "$$msg_ref\n";
}elsif($cmd =~ /q/i){
print " o Quit!\n";
last;
}elsif($cmd =~ /e/i){
$msg_ref = \"
(xbone 1.5 2.5
(credential (user_name 'Yu-Shun Wang') (user_email yushunwa\@isi.edu)
(auth_type X509))
(error_reply (function xb_test) (reason haha) (more hahaha)))
";
}else{
print " ! Invalid input: $cmd; try again.\n";
next;
}
# parse the commond
if($use_xml){
my $result = XB_XML_scan::XB_XML_parse ($msg_ref);
if ($result){
$_ = XB_XML_scan::XB_XML_choose_parse_error ($result);
print STDERR "FAILURE!!\n\nCHOSEN ERROR STRING: $_\n\n";
exit (1);
};
my $obj_hash = XB_XML_scan::XB_XML_hash ($msg_ref);
my $cmdhref = $obj_hash->{'command'};
my $covlhref = $cmdhref->{'create_overlay'};
my $xolhref = $covlhref->{'xol_program'};
XB_XML_scan::XB_XOL_xbone_list_sub ($obj_hash);
XB_XML_scan::XB_XOL_synonym_sub ($obj_hash, $xolhref->{'equivto'});
print "XML hash: ", Dumper($obj_hash);
}else{
my $api_cmd = $api_parser->API($$msg_ref);
unless(defined $api_cmd){
print " ! API Parser failed!\n";
exit(1);
}else{
print " o API command parsed ok.\n";
#print " - dump ", Dumper($api_cmd), "====\n";
}
}
# create TCP/SSL socket & connect to server
# try v4 and if that doesnt work, try v6
my $errmsg = "";
eval {
$sock = IO::Socket::SSL->new(
PeerAddr => $peer,
PeerPort => $XB_Params::xbone_api_port,
Proto => 'tcp',
Reuse => 1,
SSL_use_cert => 1,
SSL_verify_mode => 0x01,
SSL_key_file => "$client_params{node_key}",
SSL_cert_file => "$client_params{node_cert}",
SSL_ca_file => "$client_params{ca_cert}",
SSL_ca_path => "$client_params{ca_path}"
);
};
if ($@) {
$errmsg = $@;
}
if (not defined $sock){
eval {
# try v6
my ($family, $socktype, $proto, $saddr, $canonname);
my @res = getaddrinfo($peer, 'daytime', AF_INET6);
while (scalar(@res) >= 5) {
# the v6 lookup can return multiple ip addresses some of
# which may not work. So, try all of them.
$family = -1; # for safety
($family, $socktype, $proto, $saddr, $canonname, @res) = @res;
my ($dest, $port) =
getnameinfo($saddr, NI_NUMERICHOST | NI_NUMERICSERV);
$sock = IO::Socket::SSLv6->new(
PeerAddr => $dest,
PeerPort => $XB_Params::xbone_api_port,
Proto => 'tcp',
Reuse => 1,
SSL_use_cert => 1,
SSL_verify_mode => 0x03,
SSL_verify_mode => 0x01,
SSL_key_file => "$client_params{node_key}",
SSL_cert_file => "$client_params{node_cert}",
SSL_ca_file => "$client_params{ca_cert}",
SSL_ca_path => "$client_params{ca_path}"
);
last if $sock;
} # foreach destination ip address
}; # eval
$errmsg .= $@;
};
if (!$sock) {
print STDERR " ! create socket failed: $errmsg $!\n";
exit(0);
} else {
print STDERR "connect ($sock).\n" if ($IO::Socket::SSL::DEBUG);
}
# send API command
print $sock "$$msg_ref XBoneEOC\n";
# get response
my $sel = IO::Select->new($sock);
my $reply;
my @ready;
while (@ready = $sel->can_read){
for my $fh (@ready){
if($fh != $sock){
print " ! Unkown socket!\n";
}else{
while (my $line = <$sock>){
if($line =~ /\b$XB_Params::msg_delimiter\b/){ last; }
#print "....$line";
$reply .= $line;
}
$sel->remove($fh);
last;
}
}
}
# close TCP/SSL socket
$sock->close or die "close failed: $!";
# print results
print " o Received reply: $reply\n";
$reply =~ s/$reply/$XB_Params::msg_delimiter/g;
my $parser_err = XB_XML_scan::XB_XML_parse(\$reply);
if ($parser_err){
$_ = XB_XML_scan::XB_XML_choose_parse_error ($parser_err);
print "!!! parser error: $_";
}
#-- parse the message into hash
my $api_cmd = XB_XML_scan::XB_XML_hash (\$reply);
XB_XML_scan::XB_XOL_xbone_list_sub ($api_cmd);
my $xolhref = $api_cmd->{command}{create_overlay}{xol_program};
XB_XML_scan::XB_XOL_synonym_sub ($api_cmd, $xolhref->{'equivto'});
print "==> API Command Reply: ". Dumper($api_cmd);
}
1;
syntax highlighted by Code2HTML, v. 0.9.1