### 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.
#
# -------------------------------------------------------------------
##################################################
#
#
# XBone XML writing utilities used by GUI and OM
#
# Principal author: Gregory G. Finn
#
##################################################
package XB_XML_GUI;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();
use strict;
use Data::Dumper;
$XB_XML_GUI::XML_VERSION = '1.0';
$XB_XML_GUI::XML_ENCODING = 'UTF-8';
$XB_XML_GUI::DTD_DOCTYPE = 'xbone';
$XB_XML_GUI::DTD_SOURCE = 'SYSTEM';
$XB_XML_GUI::DTD_LOCATION = 'http://www.isi.edu/xbone/software/xbone/api-2.0.dtd';
#$XB_XML_GUI::DTD_LOCATION = 'api-2.0.dtd';
#######################################################################
#
# XB_XML_declaration_string ()
#
#######################################################################
sub XB_XML_declaration_string ()
{
my $str;
$str = '\n";
return ($str);
};
#######################################################################
#
# XB_XML_doctype_string ( type, source, filename )
#
#######################################################################
sub XB_XML_doctype_string ($$$)
{
my ($type, $source, $filename) = @_;
return ("\n");
};
#######################################################################
#
# XB_XML_quote_CDATA ( strref )
#
# Replaces characters in CDATA strings that must be quoted for XML to
# correctly complete a parse. The argument strref references the string.
# The characters quoted are:
#
# '&' ---> '&'
# '<' ---> '<'
# '>' ---> '>'
# ' ---> '''
# " ---> '"'
#
# The string referenced by strref is modifed if any quotation occurs.
#######################################################################
sub XB_XML_quote_CDATA ($)
{
my ($strref) = @_;
$$strref =~ s/&/&/g; # '&' must be the first to be quoted
$$strref =~ s//>/g;
$$strref =~ s/'/'/g; #'
$$strref =~ s/"/"/g; #"
};
#######################################################################
#
# XB_XML_create_credential_element ( indent, ahref )
#
#######################################################################
sub XB_XML_create_credential_element ($$)
{
my ($indent, $ahref) = @_;
my ($str, $nxt_indent, $sref);
$nxt_indent = ' ' . $indent;
$str = $indent . "\n";
$sref = XB_XML_create_property_elements ($nxt_indent,
'user_name', $ahref->{user_name},
'user_email', $ahref->{user_email},
'auth_type', $ahref->{auth_type}
);
$str .= $$sref;
$str .= $indent . "\n";
return (\$str);
};
#######################################################################
#
# XB_XML_create_property_element ( indent, prop, value )
#
#######################################################################
sub XB_XML_create_property_element ($$$)
{
my ($indent, $prop, $value) = @_;
my $str;
##############################
# Quote "<" and "&" characters
# so XML parse can succeed
##############################
XB_XML_quote_CDATA (\$prop);
XB_XML_quote_CDATA (\$value);
$str = "$indent" . "\n";
return \$str;
};
#######################################################################
#
# XB_XML_create_property_elements ( $indent, key, value, key, value, ... )
#
# Accepts as an argument a list (key value key value ...) where
# each key/value pair is an XML proplist element. For each pair the
# syntactically correct key="value" is created.
#
# Normally a reference to the string containing all the proplist element
# strings is returned. If the argument list is not balanced, that is,
# some key is missing its corresponding value, an empty "" value is used.
#######################################################################
sub XB_XML_create_property_elements ($;@)
{
my ($indent, $key, $value, $string, $strref);
$string = '';
$indent = shift;
while ($key = shift)
{
if (!defined ($value = shift))
{ $value = ''; };
$strref = XB_XML_create_property_element ($indent, $key, $value);
$string .= $$strref;
};
return (\$string);
}
#######################################################################
#
# XB_XML_build_create_overlay_options ( ahref, indent )
#
# ahref references a proplist (hash) containing the name/value pairs
# that are to be made properties of the XML create_overlay element.
#
# Returns a reference to the resulting XML string.
########################################################################
sub XB_XML_build_create_overlay_options ($$)
{
my ($ahref, $indent) = @_;
my ($string, $strref);
##############################
# Include mandatory properties
##############################
$strref = XB_XML_create_property_elements ( $indent,
'creator_name' => $ahref->{creator_name},
'creator_email' => $ahref->{creator_email},
'overlay_name' => $ahref->{overlay_name},
'address_type' => $ahref->{address_type},
'topology' => $ahref->{topology},
'timeout' => $ahref->{timeout},
'dns' => $ahref->{dns}
);
$string = $$strref;
#################################
# Now include optional properties
#################################
if (defined ($ahref->{dns} =~ /^yes$/i))
{
if (defined ($ahref->{name_server}))
{
$strref = XB_XML_create_property_element( $indent,
'name_server',
$ahref->{name_server} );
$string .= $$strref;
};
if (defined ($ahref->{name_server_port}))
{
$strref = XB_XML_create_property_element( $indent,
'name_server_port',
$ahref->{name_server_port} );
$string .= $$strref;
};
};
#if(defined ($ahref->{application})){
# $strref = XB_XML_GUI::XB_create_application($ahref->{application},$indent);
# $string .= $$strref;
#}
if (defined ($ahref->{custom_hostlist}))
{
$strref = XB_XML_create_property_element ( $indent,
'custom_hostlist',
$ahref->{custom_hostlist}
);
$string .= $$strref;
};
if (defined ($ahref->{search_radius}))
{
$strref = XB_XML_create_property_element ( $indent,
'search_radius',
$ahref->{search_radius}
);
$string .= $$strref;
};
if (defined ($ahref->{ldap}))
{
$strref = XB_XML_create_property_element ( $indent,
'ldap',
$ahref->{ldap}
);
$string .= $$strref;
$strref = XB_XML_create_property_element ( $indent,
'attrvals',
$ahref->{attrvals}
);
$string .= $$strref;
$strref = XB_XML_create_property_element ( $indent,
'scope',
$ahref->{scope}
);
$string .= $$strref;
};
if (defined ($ahref->{application}))
{
$strref = XB_XML_create_property_element( $indent,
'application',
$ahref->{application} );
$string .= $$strref;
if (defined ($ahref->{application_script}))
{
$strref = XB_XML_create_property_element( $indent,
'application_script',
$ahref->{application_script} );
$string .= $$strref;
};
if(defined ($ahref->{application_chksum})){
$strref = XB_XML_create_property_element(
$indent, 'application_chksum', $ahref->{application_chksum});
$string .= $$strref;
}
};
if (defined ($ahref->{manager}))
{
$strref = XB_XML_create_property_element( $indent,
'manager',
$ahref->{manager} );
$string .= $$strref;
if (defined ($ahref->{manager_port}))
{
$strref = XB_XML_create_property_element( $indent,
'manager_port',
$ahref->{manager_port} );
$string .= $$strref;
};
};
if (defined ($ahref->{address_server}))
{
$strref = XB_XML_create_property_element( $indent,
'address_server',
$ahref->{address_server} );
$string .= $$strref;
if (defined ($ahref->{address_server_port}))
{
$strref = XB_XML_create_property_element( $indent,
'address_server_port',
$ahref->{address_server_port} );
$string .= $$strref;
};
};
if (defined ($ahref->{dummynet}))
{
$strref = XB_XML_create_property_element( $indent,
'dummynet',
$ahref->{dummynet} );
$string .= $$strref;
if (defined ($ahref->{dummynet_bandwidth}))
{
$strref = XB_XML_create_property_element( $indent,
'dummynet_bandwidth',
$ahref->{dummynet_bandwidth} );
$string .= $$strref;
};
if (defined ($ahref->{dummynet_bandwidth_unit}))
{
$strref = XB_XML_create_property_element( $indent,
'dummynet_bandwidth_unit',
$ahref->{dummynet_bandwidth_unit} );
$string .= $$strref;
};
if (defined ($ahref->{dummynet_delay}))
{
$strref = XB_XML_create_property_element( $indent,
'dummynet_delay',
$ahref->{dummynet_delay} );
$string .= $$strref;
};
if (defined ($ahref->{dummynet_loss_rate}))
{
$strref = XB_XML_create_property_element( $indent,
'dummynet_loss_rate',
$ahref->{dummynet_loss_rate} );
$string .= $$strref;
};
if (defined ($ahref->{dummynet_queue}))
{
$strref = XB_XML_create_property_element( $indent,
'dummynet_queue',
$ahref->{dummynet_queue} );
$string .= $$strref;
};
if (defined ($ahref->{dummynet_queue_unit}))
{
$strref = XB_XML_create_property_element( $indent,
'dummynet_queue_unit',
$ahref->{dummynet_queue_unit} );
$string .= $$strref;
};
};
return (\$string);
};
######################################################################
#
# XB_build_create_overlay_msg ( ahref )
#
# ahref is a reference to a proplist (hash) that contains all the
# name/value information needed to build a create_overlay XML element.
#
# This routine returns a reference to a string containing the
# create_overlay XML element.
#######################################################################
sub XB_build_create_overlay_msg ($)
{
my ($ahref) = @_;
my ($string, $sref, $cred_indent, $cmd_indent);
$cred_indent = ' ';
$cmd_indent = ' ' . $cred_indent;
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$string .= "\n";
$sref = XB_XML_create_credential_element ( $cred_indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$sref;
$string .= $cred_indent . "\n";
$string .= $cmd_indent . "\n";
$sref = XB_XML_build_create_overlay_options ( $ahref, $cmd_indent . ' ' );
$string .= $$sref;
$sref = XB_build_xol_program_msg ( $ahref, $cmd_indent . ' ');
$string .= $$sref;
$string .= $cmd_indent . "\n";
$string .= $cred_indent . "\n";
$string .= "\n";
return (\$string);
}
#######################################################################
#
# XB_build_destroy_overlay_msg ( ahref )
#
#######################################################################
sub XB_build_destroy_overlay_msg ($)
{
my ($ahref) = @_;
my ($string, $sref, $cred_indent, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$cred_indent = ' ';
$cmd_indent = ' ' . $cred_indent;
$string .= "\n";
$sref = XB_XML_create_credential_element ( $cred_indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$sref;
$string .= $cred_indent . "\n";
$string .= $cmd_indent . "\n";
$sref = XB_XML_create_property_elements ( ' ' . $cmd_indent,
'overlay_name' => $ahref->{overlay_name}
);
$string .= $$sref;
$string .= $cmd_indent . "\n"; # end destroy_overlay
$string .= $cred_indent . "\n";
$string .= "\n"; # end xbone
return (\$string);
}
#######################################################################
#
# XB_build_overlay_status_msg ( ahref )
#
#######################################################################
sub XB_build_overlay_status_msg ($)
{
my ($ahref) = @_;
my ($string, $sref, $cred_indent, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$string .= "\n";
$cred_indent = ' ';
$cmd_indent = ' ' . $cred_indent;
$sref = XB_XML_create_credential_element ( $cred_indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$sref;
$string .= $cred_indent . "\n";
$string .= $cmd_indent . "\n";
$sref = XB_XML_create_property_elements ( ' ' . $cmd_indent,
'overlay_name' => $ahref->{overlay_name}
);
$string .= $$sref;
$string .= $cmd_indent . "\n"; # end overlay_status element
$string .= $cred_indent . "\n";
$string .= "\n"; # end xbone element
return (\$string);
}
#######################################################################
#
# XB_build_discover_daemons_msg ( ahref )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# user_name, user_email, auth_type, creator_name, creator_email,
# search_radius, timeout
#
#######################################################################
sub XB_build_discover_daemons_msg ($)
{
my ($ahref) = @_;
my ($string, $sref, $cred_indent, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$string .= "\n";
$cred_indent = ' ';
$cmd_indent = ' ' . $cred_indent;
$sref = XB_XML_create_credential_element ( $cred_indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$sref;
$string .= $cred_indent . "\n";
$string .= $cmd_indent . "\n";
$sref = XB_XML_create_property_elements ( ' ' . $cmd_indent,
'creator_name' => $ahref->{creator_name},
'creator_email' => $ahref->{creator_email},
'timeout', $ahref->{timeout},
);
$string .= $$sref;
########################
# Append custom_hostlist
# property if it exists
########################
if (defined ($ahref->{custom_hostlist}))
{
$sref = XB_XML_create_property_element ( ' ' . $cmd_indent,
'custom_hostlist',
$ahref->{custom_hostlist}
);
$string .= $$sref;
};
if (defined ($ahref->{search_radius}))
{
$sref = XB_XML_create_property_element ( ' ' . $cmd_indent,
'search_radius',
$ahref->{search_radius}
);
$string .= $$sref;
};
if (defined ($ahref->{ldap}))
{
$sref = XB_XML_create_property_element ( ' ' . $cmd_indent,
'ldap',
$ahref->{ldap}
);
$string .= $$sref;
$sref = XB_XML_create_property_element ( ' ' . $cmd_indent,
'attrvals',
$ahref->{attrvals}
);
$string .= $$sref;
$sref = XB_XML_create_property_element ( ' ' . $cmd_indent,
'scope',
$ahref->{scope}
);
$string .= $$sref;
};
$string .= $cmd_indent . "\n"; # end discover_daemons element
$string .= $cred_indent . "\n";
$string .= "\n"; # end xbone element
return (\$string);
}
#######################################################################
#
# XB_build_destroyall_overlays_msg ( ahref )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# user_name, user_email, auth_type
#
#######################################################################
sub XB_build_destroyall_overlays_msg ($)
{
my ($ahref) = @_;
my ($string, $sref, $cred_indent, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$string .= "\n";
$cred_indent = ' ';
$cmd_indent = ' ' . $cred_indent;
$sref = XB_XML_create_credential_element ( $cred_indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$sref;
$string .= $cred_indent . "\n";
$string .= $cmd_indent . "\n";
$string .= $cred_indent . "\n";
$string .= "\n"; # end xbone element
return (\$string);
}
#######################################################################
#
# XB_build_list_overlays_msg ( ahref )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# user_name, user_email, auth_type
#
#######################################################################
sub XB_build_list_overlays_msg ($)
{
my ($ahref) = @_;
my ($string, $sref, $cred_indent, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$string .= "\n";
$cred_indent = ' ';
$cmd_indent = ' ' . $cred_indent;
$sref = XB_XML_create_credential_element ( $cred_indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$sref;
$string .= $cred_indent . "\n";
$string .= $cmd_indent . "\n";
$string .= $cred_indent . "\n";
$string .= "\n"; # end xbone element
return (\$string);
}
#######################################################################
#
# XB_build_create_overlay_reply_msg ( ahref, nodeslref )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# creator_name, creator_email, auth_type, overlay_name, topology
#
# nodeslref references a list of lists [ [x], [x], ... ]. Each enclosed list
# contains descriptive information that describes an overlay node. This
# information takes the form:
#
# 'class' => $class,
# 'name_server' => $name_server,
# 'ip_address' => $ip_address,
# 'os' => $os,
# 'status' => $status,
# 'interfaces' => $interfaces,
# 'tunnels' => [ [tunnel props], [tunnel props], ...]
#
# See XB_XML_create_node_element() for a more complete description.
#
#######################################################################
sub XB_build_create_overlay_reply_msg ($$)
{
my ( $ahref, $nodeslref ) = @_;
my ($string, $indent, $nxt_indent, $strref, $nodelref, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$indent = ' ';
$cmd_indent = ' ' . $indent;
$nxt_indent = ' ' . $cmd_indent;
$string .= "{protocol}\"" .
" release=\"$ahref->{release}\">\n";
$strref = XB_XML_create_credential_element ( $cmd_indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$strref;
$string .= $indent . "\n";
$string .= $cmd_indent . "\n";
##############################
# Include mandatory properties
##############################
$strref = XB_XML_create_property_elements ( $nxt_indent,
'overlay_name' => $ahref->{overlay_name},
'dns' => $ahref->{dns},
'routing' => $ahref->{routing},
'IPsec_encryption' => $ahref->{IPsec_encr},
'IPsec_authentication' => $ahref->{IPsec_auth}
);
$string .= $$strref;
##########################
# Create the node elements
##########################
foreach $nodelref (@$nodeslref)
{
$strref = XB_XML_create_node_element ($nxt_indent, $nodelref);
$string .= $$strref;
};
$string .= $cmd_indent . "\n";
$string .= $indent . "\n";
$string .= "\n";
return (\$string);
}
#######################################################################
#
# XB_build_destroy_overlay_reply_msg ( ahref, overlay )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# user_name, user_email, auth_type
#
# The overlay argument is the string name of an overlay.
#
#######################################################################
sub XB_build_destroy_overlay_reply_msg ($$)
{
my ($ahref, $overlay) = @_;
my ($indent, $nxt_indent, $string, $strref, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$indent = ' ';
$cmd_indent = ' ' . $indent;
$nxt_indent = ' ' . $cmd_indent;
$string .= "\n";
#$strref = XB_XML_create_credential_element ( $indent,
# { 'user_name' => $ahref->{user_name},
# 'user_email' => $ahref->{user_email},
# 'auth_type' => $ahref->{auth_type} }
# );
#$string .= $$strref;
$string .= $indent . "\n";
$string .= $cmd_indent . "\n";
$strref = XB_XML_create_property_elements ( $nxt_indent,
'overlay_name' => $overlay );
$string .= $$strref;
$string .= $cmd_indent . "\n";
$string .= $indent . "\n";
$string .= "\n";
return (\$string);
}
#######################################################################
#
# XB_build_overlay_status_reply_msg ( ahref, nodeslref )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# auth_type, creator_name, creator_email, ipsec_auth, ipsec_encr,
# topology, overlay_name
#
# nodeslref references a list of lists [ [x], [x], ... ]. Each enclosed list
# contains descriptive information that describes an overlay node. This
# information takes the form:
#
# 'class' => 'host' or 'router' (now likely obsolete)
# 'id' => node name
# 'iface' => iface name,
# 'ip_address' => ip address,
# 'os' => os name,
# 'status' => status,
#
# 'tunnels' => [ [tunnel props], [tunnel props], ... ]
#
#
# Each list in the 'tunnels' list contains three name/value pairs:
#
# 'local_ip_address' => local address,
# 'remote_ip_address' => remote address,
# 'status' => status
#
#######################################################################
sub XB_build_overlay_status_reply_msg ($$)
{
my ($ahref, $nodeslref) = @_;
my ($indent, $nxt_indent, $string, $strref, $nodelref, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$indent = ' ';
$cmd_indent = ' ' . $indent;
$nxt_indent = ' ' . $cmd_indent;
$string .= "{protocol}\"" .
" release=\"$ahref->{release}\">\n";
$strref = XB_XML_create_credential_element ( $indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type} });
$string .= $$strref;
$string .= $indent . "\n";
$string .= $cmd_indent . "\n";
$strref = XB_XML_create_property_elements ( $nxt_indent,
'overlay_name' => $ahref->{overlay_name},
'dns' => $ahref->{dns},
'routing' => $ahref->{routing},
'IPsec_authentication' => $ahref->{IPsec_auth},
'IPsec_encryption' => $ahref->{IPsec_encr}
);
$string .= $$strref;
##########################
# Create the node elements
##########################
foreach $nodelref (@$nodeslref)
{
$strref = XB_XML_create_node_element ($nxt_indent, $nodelref);
$string .= $$strref;
};
$string .= $cmd_indent . "\n";
$string .= $indent . "\n";
$string .= "\n";
return (\$string);
}
#######################################################################
#
# XB_build_discover_daemons_reply_msg ( ahref, nodeslref )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# auth_type, creator_name, creator_email
#
# nodeslref references a list of lists [ [x], [x], ... ]. Each enclosed list
# contains descriptive information that describes an overlay node. This
# information takes the form:
#
# 'class' => $class,
# 'name_server' => $dns_name,
# 'ip_address' => $ip_address,
# 'os' => $os,
# 'release' => $release,
# 'dynamic_routing' => $dynamic_routing,
# 'IPsec_authentication' => $ipsec_auth,
# 'IPsec_encryption' => $ipsec_encr,
# 'overlays' => $overlays,
# 'max_overlays' => $max_overlays,
# 'tunnel_count' => $tunnels,
# 'max_tunnels' => $max_tunnels,
# 'dummynet' => $dummynet
#
#######################################################################
sub XB_build_discover_daemons_reply_msg ($$)
{
my ($ahref, $nodeslref ) = @_;
my ($indent, $nxt_indent, $string, $strref, $nodelref, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$indent = ' ';
$cmd_indent = ' ' . $indent;
$nxt_indent = ' ' . $cmd_indent;
$string .= "\n";
$strref = XB_XML_create_credential_element ( $indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$strref;
$string .= $indent . "\n";
$string .= $cmd_indent . "\n";
$strref = XB_XML_create_property_elements ( $nxt_indent,
'creator_name' => $ahref->{creator_name},
'creator_email' => $ahref->{creator_email} );
$string .= $$strref;
##########################
# Create the node elements
##########################
foreach $nodelref (@$nodeslref)
{
$strref = XB_XML_create_node_element ($nxt_indent, $nodelref);
$string .= $$strref;
};
$string .= $cmd_indent . "\n";
$string .= $indent . "\n";
$string .= "\n";
return (\$string);
}
#######################################################################
#
# XB_build_destroyall_overlays_reply_msg ( ahref, message )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# user_name, user_email, auth_type
#
# message is a string that is used to create the XML property element
# message="$message" which constitutes the reply content.
#######################################################################
sub XB_build_destroyall_overlays_reply_msg ($$)
{
my ($ahref, $message) = @_;
my ($indent, $nxt_indent, $string, $strref, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$indent = ' ';
$cmd_indent = ' ' . $indent;
$nxt_indent = ' ' . $cmd_indent;
$string .= "\n";
$strref = XB_XML_create_credential_element ( $indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$strref;
$string .= $indent . "\n";
$string .= $cmd_indent . "\n";
$strref = XB_XML_create_property_elements ( $nxt_indent, 'message' => $message );
$string .= $$strref;
$string .= $cmd_indent . "\n";
$string .= $indent . "\n";
$string .= "\n";
return (\$string);
}
#######################################################################
#
# XB_build_list_overlays_reply_msg ( ahref, names_sref )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# user_name, user_email, auth_type
#
# The names_sref is a reference to a string that contains overlay names.
# Overlay names are separated by whitespace.
#
# A reference to the message string is returned.
#######################################################################
sub XB_build_list_overlays_reply_msg ($$)
{
my ($ahref, $names_sref) = @_;
my ($string, $sref, $indent, $nxt_indent, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$indent = ' ';
$cmd_indent = ' ' . $indent;
$nxt_indent = ' ' . $cmd_indent;
$string .= "{protocol}\"" .
" release=\"$ahref->{release}\">\n";
#$strref = XB_XML_create_credential_element ( $indent,
# { 'user_name' => $ahref->{user_name},
# 'user_email' => $ahref->{user_email},
# 'auth_type' => $ahref->{auth_type} }
# );
#$string .= $$strref;
$string .= $indent . "\n";
$string .= $cmd_indent . "\n";
XB_XML_quote_CDATA ($names_sref);
$string .= $nxt_indent . "\n";
$string .= $cmd_indent . "\n";
$string .= $indent . "\n";
$string .= "\n";
return (\$string);
}
######################################################################
#
# sub XB_build_api_errmsg ( ahref, error_message )
#
# ahref references a proplist (hash) containing the following name/value
# pairs:
# user_name, user_email, auth_type, command
#
# Builds a message with the indicated command and one criterion pair
# error/error_message.
#
# A reference to the message string is returned.
######################################################################
sub XB_build_api_errmsg ($$)
{
my ($ahref, $error_message) = @_;
my ($string, $indent, $nxt_indent, $strref, $cmd_indent);
$string = XB_XML_declaration_string () .
XB_XML_doctype_string ( $XB_XML_GUI::DTD_DOCTYPE,
$XB_XML_GUI::DTD_SOURCE,
$XB_XML_GUI::DTD_LOCATION );
$indent = ' ';
$cmd_indent = ' ' . $indent;
$nxt_indent = ' ' . $cmd_indent;
$string .= "\n";
$strref = XB_XML_create_credential_element ( $indent,
{ 'user_name' => $ahref->{user_name},
'user_email' => $ahref->{user_email},
'auth_type' => $ahref->{auth_type}
}
);
$string .= $$strref;
$string .= $indent . "\n";
$string .= $cmd_indent . "\n";
$strref = XB_XML_create_property_element ($nxt_indent, 'command',
$ahref->{command});
$string .= $$strref;
$strref = XB_XML_create_property_element ($nxt_indent, 'error',
$error_message);
$string .= $$strref;
$string .= $cmd_indent . "\n";
$string .= $indent . "\n";
$string .= "\n";
return (\$string);
}
###################################################################
#
# XB_XML_create_interfaces ( iflref, indent )
#
# iflref is a reference to a list of interface specifications, which
# take the form ( name, ifplref, name, ifplref ... )
#
# Returns a reference to a string of XML iface elements.
###################################################################
sub XB_XML_create_interfaces ($;$)
{
my ($iflref, $indent) = @_;
my ($string, $ifname, $ifplref, $strref);
if (!defined ($indent)) { $indent = ''; };
while (defined ($ifname = shift (@$iflref)))
{
$ifplref = shift (@$iflref); # Get interface properties
$strref = XB_XML_create_interface ($ifname, $ifplref, $indent);
$string .= $$strref;
};
return (\$string);
}
###################################################################
#
# XB_XML_create_interface ( ifname, ifplref, $indent )
#
# ifname is the name of the interface
# ifplref is a reference to a list of interface specifications, which
# take the form ( name, value, name, value ... )
#
# Returns a reference to the resulting XML iface element string.
###################################################################
sub XB_XML_create_interface ($$;$)
{
my ($ifname, $ifplref, $indent) = @_;
my ($string, $strref, $nxt_indent);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = $indent . "\n";
$strref = XB_XML_create_property_elements ($nxt_indent, @$ifplref);
$string .= $$strref;
$string .= $indent . "\n";
return (\$string);
}
###################################################################
#
# XB_XML_create_renamed_interface ( ifname, rnlref, indent )
#
# ifname is the name of the interface
# rnlref is a reference to a renames element specification list,
# which takes the form (node_name, iface_name)
#
# Returns a reference to the resulting XML iface element string.
###################################################################
sub XB_XML_create_renamed_interface ($$;$)
{
my ($ifname, $rnlref, $indent) = @_;
my ($string, $strref, $nxt_indent);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = $indent . "\n";
$strref = XB_XML_create_renames_element ($rnlref, $nxt_indent);
$string .= $$strref;
$string .= $indent . "\n";
return (\$string);
}
###################################################################
#
# XB_XML_create_endpoint ( vnodename, ifacename, indent )
#
# Creates an XML endpoint element, having vnode=vnodename and
# iface=ifacename.
# Returns a reference to the resulting XML endpoint element string.
###################################################################
sub XB_XML_create_endpoint ($$;$)
{
my ($vnodename, $ifacename, $indent) = @_;
my ($string);
if (!defined ($indent)) { $indent = ''; };
$string = $indent . "\n";
return (\$string);
}
###################################################################
#
# XB_create_netlist ( linkslref, indent )
#
# linkslref references a list of the form:
# ( [nodename iface linkname nodename iface] ... )
#
# This indicates that the named link connects the two specified
# endpoints, each specified by its nodename and interface.
#
# Returns a reference to a string of XML link elements.
###################################################################
sub XB_create_netlist ($;$)
{
my ($linkslref, $indent) = @_;
my ($string, $strref, $lref, $nxt_indent);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = '';
while (defined ($lref = shift (@$linkslref)))
{
$string .= $indent . "[2]\">\n";
$strref = XB_XML_create_endpoint ($lref->[0], $lref->[1], $nxt_indent);
$string .= $$strref;
$strref = XB_XML_create_endpoint ($lref->[3], $lref->[4], $nxt_indent);
$string .= $$strref;
$string .= "$indent\n";
};
return (\$string);
}
###################################################################
#
# XB_create_application ( appshref, indent )
#
# $appshref:( $app_name => ( program => $app_name,
# script => $script_url,
# checksum => $script_chksum,
# suid => $script_suid,
# nodes => $app_nodes,
# ifaces => $node_ifaces ) )
#
# Returns a reference to a string of XML link elements.
#
#
#
###################################################################
sub XB_create_application ($;$)
{
my ($appshref, $indent) = @_;
my ($string, $strref, $lref, $nxt_indent);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = '';
for my $name (keys %{$appshref}){
unless($string eq ''){ $string .= "\n"; }
my $app = $appshref->{$name};
unless(defined $app->{script}){
print "!!! Error: application script URL is missing!\n";
next;
}
my $chksum = (defined $app->{checksum})?
$nxt_indent. "checksum=\"". $app->{checksum}. "\"\n" : '';
my $suid = (defined $app->{suid})?
$nxt_indent. "suid=\"". $app->{suid}. "\"\n" : '';
my $nodes = (defined $app->{nodes})?
$nxt_indent. "nodes=\"". $app->{nodes}. "\"\n" : '';
my $ifaces = (defined $app->{ifaces})?
$nxt_indent. "ifaces=\"". $app->{ifaces}. "\"\n" : '';
$string .= $indent . "{script} ."\"\n".
$chksum. $suid. $nodes. $ifaces. $indent. "/>";
}
return (\$string);
}
###################################################################
#
# XB_XML_create_renames_element ( rlref, indent )
#
# rlref references a list of the form:
# (nodename iface name value name value ...)
#
# This routine creates an XML renames element. The first two items
# in the rlref list constitute the arguments of an endpoint, while
# the rest are property name/value pairs.
#
# Returns a reference to an XML renames element string.
###################################################################
sub XB_XML_create_renames_element ($;$)
{
my ($rlref, $indent) = @_;
my ($string, $strref, $nxt_indent);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = $indent . "\n";
$strref = XB_XML_create_endpoint (shift (@$rlref), shift (@$rlref), $nxt_indent);
$string .= $$strref;
$strref = XB_XML_create_property_elements ($nxt_indent, @$rlref);
$string .= $$strref;
$string .= $indent . "\n";
return (\$string);
}
#######################################################################
#
# XB_build_xol_program_msg ( ahref, indent )
#
#######################################################################
sub XB_build_xol_program_msg ($;$)
{
my ( $ahref, $indent ) = @_;
my ($string, $sref, $omref, $nxt_indent);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . "$indent";
$string .= $indent . "\n";
######################
# Generate the network
######################
$sref = XB_create_net_topology ( $ahref, $nxt_indent );
$string .= $$sref;
#################################
# Identify network to instantiate
#################################
$_ = XB_XML_create_vnode ([ $ahref->{overlay_name}, $ahref->{topology} ],
$nxt_indent);
$string .= $$_;
$string .= $indent . "\n";
return (\$string);
}
###################################################################
#
# XB_create_net_topology ( ahref, indent )
#
# Creates a network topology string.
#
# A reference to the program string created is usually returned.
# A false result is returned on error.
###################################################################
sub XB_create_net_topology ($;$)
{
my ($ahref, $indent) = @_;
my ($type, $result);
if (!defined ($indent))
{ $indent = ''; };
$result = 0;
$type = $ahref->{topology};
if ($type eq 'star')
{ $result = XB_create_topology_star_msg ( $ahref, $indent );
}
elsif ($type eq 'linear')
{ $result = XB_create_topology_line_msg ( $ahref, $indent );
}
elsif ($type eq 'ring')
{ $result = XB_create_topology_ring_msg ( $ahref, $indent );
}
elsif ($type eq 'custom')
{ $result = XB_create_topology_custom_msg ( $ahref, $indent );
}
else
{ die ("Unknown network type:$type passed"); }; # Unknown network topology
return ($result);
}
#######################################################################
#
# XB_XML_create_tunnel_element ( indent, name => value, name => value, ... )
#
# The tunnel name/value pairs currently defined are:
#
# 'local_ip_address' => IP address
# 'remote_ip_address' => IP address
# 'status' => 'up' or 'down'
#
#######################################################################
sub XB_XML_create_tunnel_element ($@)
{
my ($string, $indent, $nxt_indent, $strref);
$indent = shift (@_);
$nxt_indent = ' ' . $indent;
$string = $indent . "\n";
$strref = XB_XML_create_property_elements ($nxt_indent, @_);
$string .= $$strref;
$string .= $indent . "\n";
return (\$string);
};
###################################################################
#
# XB_XML_create_node_element ( indent, propslref )
#
# propslref references a list: [ name => value, name => value ...]
#
# The property name 'tunnels' is specially treated. If this property
# exists, its value references a tunnel description list of lists:
#
# [ [name => value, ...] [name => value, ...] ...]
#
# Each element within a 'tunnels' list results in a separate
# XML tunnel element string being created.
#
# Returns a reference to an XML node element string. The resulting
# node contains the properties passed as name/value pairs
###################################################################
sub XB_XML_create_node_element ($$)
{
my ($indent, $propslref) = @_;
my ($string, $strref, $nxt_indent, $tunnellref, $name, $value);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = $indent . "\n";
my @propslref_aux = ();
while ($name = shift (@$propslref))
{
$value = shift (@$propslref);
if ($name ne 'tunnels') # node properties
{
$strref = XB_XML_create_property_element ($nxt_indent, $name, $value);
$string .= $$strref;
}
else
{
unshift @propslref_aux, $value;
unshift @propslref_aux, $name;
}
};
@$propslref = @propslref_aux;
while ($name = shift (@$propslref))
{
$value = shift (@$propslref);
if ($name eq 'tunnels') # node properties
{
foreach $tunnellref (@$value)
{
$strref = XB_XML_create_tunnel_element ($nxt_indent, @$tunnellref);
$string .= $$strref;
};
};
};
$string .= $indent . "\n";
return (\$string);
}
###################################################################
#
# XB_XML_create_node_def ( nref, indent )
#
# nref is a reference to a list of information associated with a node.
# It takes the format ( name ifaces links vnodes propstr )
# name ---- string ident
# ifaces -- see XB_XML_create_interfaces()
# vnodes -- see XB_XML_create_vnodes()
# links -- see XB_create_netlist()
# propstr - see XB_create_nodeprops()
# application
#
# If any of the referenced arguments, ifaces, links, vnodes, propstr
# reference a SCALAR rather than a list, the string is assumed to be
# the completed set of ifaces, links, propstr or vnodes.
#
# Returns a reference to a XML node_def element string.
###################################################################
sub XB_XML_create_node_def ($;$)
{
my ($nref, $indent) = @_;
my ($string, $strref, $nxt_indent);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = $indent . "[0]\">\n";
if (ref ($nref->[1]) eq 'SCALAR')
{ $strref = $nref->[1]; }
else
{ $strref = XB_XML_create_interfaces ($nref->[1], $nxt_indent); };
$string .= $$strref;
if (ref ($nref->[2]) eq 'SCALAR')
{ $strref = $nref->[2]; }
else
{ $strref = XB_XML_create_vnodes ($nref->[2], $nxt_indent); }
$string .= $$strref;
if (ref ($nref->[3]) eq 'SCALAR')
{ $strref = $nref->[3]; }
else
{ $strref = XB_create_netlist ($nref->[3], $nxt_indent); }
$string .= $$strref;
if (ref ($nref->[4]) eq 'SCALAR')
{ $strref = $nref->[4]; }
else
{ $strref = XB_XML_create_property_elements ($nxt_indent, @{$nref->[4]}); };
$string .= $$strref;
if(ref ($nref->[5]) eq 'SCALAR'){
$strref = $nref->[5];
}else{
#$strref = XB_XML_GUI::XB_create_application( $nref->[5], $nxt_indent);
my $empty = '';
$strref = \$empty;
}
$string .= $$strref;
$string .= $indent . "\n";
return (\$string);
}
###################################################################
#
# XB_XML_create_vnodes ( nlref, indent )
#
# nlref is reference to a list of lists:
#
# [ [identity, type, name, value, name, value, ...] ..... ]
#
# Returns a reference to a string of XML vnode elements.
###################################################################
sub XB_XML_create_vnodes ($;$)
{
my ($nlref, $indent) = @_;
my ($string, $strref, $nref);
if (!defined ($indent)) { $indent = ''; };
$string = '';
foreach $nref (@$nlref)
{
$strref = XB_XML_create_vnode ($nref, $indent);
$string .= $$strref;
};
return (\$string);
}
###################################################################
#
# XB_XML_create_vnode ( nlref, indent )
#
# nlref is reference to a list that has the format:
#
# ( identity, type, name, value, name, value, ...)
#
# where identity is the vnode ident and the remaining arguments
# constitute this vnode's type and properties.
#
# Returns a reference to an XML vnode element string.
###################################################################
sub XB_XML_create_vnode ($;$)
{
my ($nlref, $indent) = @_;
my ($string, $strref, $nxt_indent, $identity, $type);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$identity = shift (@$nlref);
$type = shift (@$nlref);
$string = $indent . "\n";
$strref = XB_XML_create_property_elements ($nxt_indent, @$nlref);
$string .= $$strref;
$string .= $indent . "\n";
return (\$string);
}
###################################################################
#
# XB_create_topology_star_msg ( ahref, indent )
#
# Creates the needed XML node_def elements of a star network.
# ahref references a hash that contains values needed.
#
# One router is created. Interface, router and host names are picked
# by this routine. A reference to the string created is returned.
###################################################################
sub XB_create_topology_star_msg ($;$)
{
my ($ahref, $indent) = @_;
my ($hosts, $host_os, $router_os, $string);
my ($hprotosref, $hprotoname, $rprotosref, $rprotoname,
$vnodeslref, $propslref, $iflref, $ix, $nprotosref, $nprotoname, $sref,
$ifacesstr, $nxt_indent, $linkslref);
$hosts = $ahref->{hosts};
$host_os = $ahref->{host_os};
$router_os = $ahref->{router_os};
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
################################
# Create host node_def prototype
# one exportable iface
################################
$hprotoname = 'star_host';
$hprotosref = XB_XML_create_node_def (
[
$hprotoname, # host prototype name
['if_0', []], # one interface for host prototype, no iface props
[], # no vnodes for host prototype
[], # no links for host prototype
['os' => $host_os], # just os=host_os for properties
[] # application
],
$indent);
$string = $$hprotosref;
##################################
# Create router node_def prototype
# one exportable iface, plus
# one for each host
##################################
$rprotoname = 'star_router';
$iflref = [];
for ($ix = 0; $ix <= $hosts; $ix++)
{
push (@$iflref, "if_$ix");
push (@$iflref, []); # no iface properties
};
$rprotosref = XB_XML_create_node_def (
[
$rprotoname, # router prototype name
$iflref, # interfaces
[], # no vnodes for router prototype
[], # no links for router prototype
[ 'os' => $router_os ], # just os=router_os for properties
[] # application
],
$indent);
$string .= $$rprotosref;
#################################
# Now create the node_def element
# for the star network itself
#################################
$nprotoname = $ahref->{topology};
####################################
# Create the exported iface, using
# router_0, which is a 'star_router'
####################################
$sref = XB_XML_create_renamed_interface (
'exp_0',
[ 'router_0', "if_$hosts" ],
$nxt_indent
);
$ifacesstr = $$sref;
###################
# Create the vnodes
###################
$vnodeslref = [];
for ($ix = 0; $ix < $hosts; $ix++)
{
push (@$vnodeslref, [ "host_$ix", $hprotoname] ); # The host vnodes
};
push (@$vnodeslref, [ 'router_0', $rprotoname] ); # The router vnode
##################
# Create the links
##################
$linkslref = [];
for ($ix = 0; $ix < $hosts; $ix++)
{
push (@$linkslref, [ "host_$ix", 'if_0', "link_$ix", 'router_0', "if_$ix" ] );
};
# Check if application deployment
my $appstrr;
if(defined ($ahref->{application})){
$appstrr = XB_XML_GUI::XB_create_application(
$ahref->{application}, $nxt_indent);
}else{
$appstrr = '';
}
############################
# Build the node_def element
############################
$nprotosref = XB_XML_create_node_def (
[
$nprotoname, # net prototype name
\$ifacesstr, # export exp_0
$vnodeslref, # vnodes for star network
$linkslref, # links that form star network
[ # node_def properties
'IPsec_authentication' => $ahref->{IPsec_authentication},
'dns' => $ahref->{dns},
'dynamic_routing' => $ahref->{dynamic_routing},
'IPsec_encryption' => $ahref->{IPsec_encryption},
'address_type' => $ahref->{address_type},
'deployment' => $ahref->{deployment}
],
$appstrr
],
$indent);
$string .= $$nprotosref;
return (\$string);
};
###################################################################
#
# XB_create_topology_line_msg ( ahref, indent )
#
# Creates the needed XML node_def elements of a line network.
# ahref references a hash that contains values needed.
#
# Interface, router and host names are picked by this routine.
# A reference to the string created is returned.
###################################################################
sub XB_create_topology_line_msg ($;$)
{
my ($ahref, $indent) = @_;
my ($hosts, $host_os, $routers, $router_os, $nxt_indent, $string);
my ($hprotosref, $hprotoname, $leftrprotosref, $leftrprotoname,
$vnodeslref, $propslref, $iflref, $ix, $nprotosref, $nprotoname, $sref, $link,
$ifacesstr, $linkslref, $left_hosts, $right_hosts, $center_routers,
$centerrprotoname, $centerrprotosref, $rightrprotosref, $rightrprotoname,
$router_name );
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$hosts = $ahref->{hosts};
$host_os = $ahref->{host_os};
$routers = $ahref->{routers};
$router_os = $ahref->{router_os};
#####################################
# A one router line network is a star
#####################################
if ($routers == 1)
{ return (XB_create_topology_star_msg ($ahref, $indent) ); };
###############################
# Number of hosts at either end
###############################
$left_hosts = $hosts >> 1;
$right_hosts = $hosts - $left_hosts;
$center_routers = $ahref->{routers} - 2;
################################
# Create host node_def prototype
# one exportable iface
################################
$hprotoname = 'line_host';
$hprotosref = XB_XML_create_node_def (
[
$hprotoname, # host prototype name
[ 'if_0', [] ], # one interface for host prototype, no iface props
[], # no vnodes for host prototype
[], # no links for host prototype
[ 'os' => $host_os ], # just os=host_os for properties
[]
],
$indent);
$string = $$hprotosref;
#################################
# Create center-position router
# node_def prototype. These have
# two exportable ifaces.
#################################
if ($center_routers > 0)
{
$centerrprotoname = 'line_center_router';
$iflref = [];
push (@$iflref, 'left_0'); # iface to connect to the left
push (@$iflref, []); # no iface properties
push (@$iflref, 'right_0'); # iface to connect to the right
push (@$iflref, []); # no iface properties
$centerrprotosref = XB_XML_create_node_def (
[
$centerrprotoname, # router prototype name
$iflref, # interfaces
[], # no vnodes for router prototype
[], # no links for router prototype
[ 'os' => $router_os ], # just os=router_os for properties
[]
],
$indent);
$string .= $$centerrprotosref;
};
#################################
# Create left-end-position router
# node_def prototype. This has
# $left_hosts ifaces, plus one to
# connect to right plus one
# exportable ifaces.
#################################
$leftrprotoname = 'line_left_router';
$iflref = [];
for ($ix = 0; $ix < $left_hosts; $ix++)
{
push (@$iflref, "if_$ix");
push (@$iflref, []); # no iface properties
};
push (@$iflref, 'exp_0'); # export iface
push (@$iflref, []); # no iface properties
push (@$iflref, 'right_0'); # iface to connect to the right
push (@$iflref, []); # no iface properties
$leftrprotosref = XB_XML_create_node_def (
[
$leftrprotoname, # router prototype name
$iflref, # interfaces
[], # no vnodes for router prototype
[], # no links for router prototype
[ 'os' => $router_os ], # just os=router_os for properties
[]
],
$indent);
$string .= $$leftrprotosref;
##################################
# Create right-end-position router
# node_def prototype. This has
# $right_hosts ifaces, plus one to
# connect to left.
##################################
$rightrprotoname = 'line_right_router';
$iflref = [];
for ($ix = 0; $ix < $right_hosts; $ix++)
{
push (@$iflref, "if_$ix");
push (@$iflref, []); # no iface properties
};
push (@$iflref, 'left_0'); # iface to connect to the left
push (@$iflref, []); # no iface properties
$rightrprotosref = XB_XML_create_node_def (
[
$rightrprotoname, # router prototype name
$iflref, # interfaces
[], # no vnodes for router prototype
[], # no links for router prototype
[ 'os' => $router_os ], # just os=router_os for properties
[]
],
$indent);
$string .= $$rightrprotosref;
#################################
# Now create the node_def element
# for the line network itself
#################################
$nprotoname = $ahref->{topology};
##########################################
# Create the exported iface using router_0
# which is a 'line_left_router'
##########################################
$sref = XB_XML_create_renamed_interface (
'exp_0',
[ 'router_0', 'exp_0' ],
$nxt_indent
);
$ifacesstr = $$sref;
###################
# Create the vnodes
###################
$vnodeslref = [];
for ($ix = 0; $ix < $hosts; $ix++)
{
push (@$vnodeslref, [ "host_$ix", $hprotoname] ); # host vnodes
};
push (@$vnodeslref, [ 'router_0', $leftrprotoname] ); # leftmost router vnode
for ($ix = 1; $ix <= $center_routers; $ix++)
{
push (@$vnodeslref, [ "router_$ix",
$centerrprotoname] ); # center router vnodes
};
$_ = $routers - 1;
push (@$vnodeslref, [ "router_$_", $rightrprotoname] ); # rightmost router vnode
######################################
# Create the links, hosts connected to
# left-end-router, hosts connected to
# right-end-router, then interconnect
# the routers
######################################
$link = 0;
$linkslref = [];
$router_name = "router_0";
for ($ix = 0; $ix < $left_hosts; $ix++) # left-end hosts
{
push (@$linkslref, [ "host_$ix", 'if_0',
"link_$link", $router_name, "if_$ix" ] );
$link++;
};
$_ = $routers - 1;
$router_name = "router_$_";
for ($ix = 0; $ix < $right_hosts; $ix++) # right-end hosts
{
$_ = $left_hosts + $ix;
push (@$linkslref, [ "host_$_", 'if_0',
"link_$link", $router_name, "if_$ix" ] );
$link++;
};
for ($ix = 0; $ix < ($routers - 1); $ix++) # router interconnects
{
$_ = $ix + 1;
push (@$linkslref, [ "router_$ix", 'right_0',
"link_$link", "router_$_", 'left_0' ] );
$link++;
};
# Check if application deployment
my $appstrr;
if(defined ($ahref->{application})){
$appstrr = XB_XML_GUI::XB_create_application(
$ahref->{application}, $nxt_indent);
}else{
$appstrr = '';
}
############################
# Build the node_def element
############################
$nprotosref = XB_XML_create_node_def (
[
$nprotoname, # net prototype name
\$ifacesstr, # export exp_0
$vnodeslref, # vnodes for star network
$linkslref, # links that form star network
[ # node_def properties
'IPsec_authentication' => $ahref->{IPsec_authentication},
'dns' => $ahref->{dns},
'dynamic_routing' => $ahref->{dynamic_routing},
'IPsec_encryption' => $ahref->{IPsec_encryption},
'address_type' => $ahref->{address_type},
'deployment' => $ahref->{deployment}
],
$appstrr
],
$indent);
$string .= $$nprotosref;
return (\$string);
};
###################################################################
#
# XB_create_topology_ring_msg ( ahref, indent )
#
# Creates the needed XML node_def elements of a ring network.
# ahref references a hash that contains values needed.
#
# Interface, router and host names are picked by this routine.
# A reference to the string created is returned.
###################################################################
sub XB_create_topology_ring_msg ($;$)
{
my ($ahref, $indent) = @_;
my ($hosts, $host_os, $routers, $router_os, $nxt_indent, $string);
my ($hprotosref, $hprotoname, $rprotosref, $rprotoname,
$vnodeslref, $propslref, $iflref, $ix, $nprotosref, $nprotoname, $sref, $link,
$ifacesstr, $linkslref);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$hosts = $ahref->{hosts};
$host_os = $ahref->{host_os};
$routers = $ahref->{routers};
$router_os = $ahref->{router_os};
#####################################
# A one router ring network is a star
#####################################
if ($routers == 1)
{ return (XB_create_topology_star_msg ($ahref, $indent) ); };
################################
# Create host node_def prototype
# one exportable iface
################################
$hprotoname = 'ring_host';
$hprotosref = XB_XML_create_node_def (
[
$hprotoname, # host prototype name
[ 'if_0', [] ], # one interface for host prototype, no iface props
[], # no vnodes for host prototype
[], # no links for host prototype
[ 'os' => $host_os ], # just os=host_os for properties
[]
],
$indent);
$string = $$hprotosref;
##################################
# Create router node_def prototype
# three exportable ifaces
##################################
$rprotoname = 'ring_router';
$iflref = [];
push (@$iflref, 'left_0'); # iface to connect to the left
push (@$iflref, []); # no iface properties
push (@$iflref, 'right_0'); # iface to connect to the right
push (@$iflref, []); # no iface properties
push (@$iflref, 'exp_0'); # iface to connect to the right
push (@$iflref, []); # no iface properties
$rprotosref = XB_XML_create_node_def (
[
$rprotoname, # router prototype name
$iflref, # interfaces
[], # no vnodes for router prototype
[], # no links for router prototype
[ 'os' => $router_os ], # just os=router_os for properties
[]
],
$indent);
$string .= $$rprotosref;
#################################
# Now create the node_def element
# for the line network itself
#################################
$nprotoname = $ahref->{topology};
######################################
# Create the exported iface using
# 'router_0', which is a 'ring_router'
######################################
$sref = XB_XML_create_renamed_interface (
'exp_0',
[ 'router_0', 'exp_0' ],
$nxt_indent
);
$ifacesstr = $$sref;
###################
# Create the vnodes
###################
$vnodeslref = [];
for ($ix = 0; $ix < $hosts; $ix++)
{
push (@$vnodeslref, [ "host_$ix", $hprotoname] ); # host vnodes
};
for ($ix = 0; $ix < $routers; $ix++)
{
push (@$vnodeslref, [ "router_$ix",
$rprotoname] ); # router vnodes
};
######################################
# Create the links, hosts dealt across
# routers, routers in a ring to each
# other
######################################
$link = 0;
$linkslref = [];
for ($ix = 0; $ix < $hosts; $ix++)
{
$_ = $ix % $routers;
push (@$linkslref, [ "host_$ix", 'if_0',
"link_$ix", "router_$_", 'if_0' ] );
$link++;
};
for ($ix = 0; $ix < $routers; $ix++) # router interconnects
{
$_ = ($ix + 1) % $routers;
push (@$linkslref, [ "router_$ix", 'right_0',
"link_$link", "router_$_", 'left_0' ] );
$link++;
};
# Check if application deployment
my $appstrr;
if(defined ($ahref->{application})){
$appstrr = XB_XML_GUI::XB_create_application(
$ahref->{application}, $nxt_indent);
}else{
$appstrr = '';
}
############################
# Build the node_def element
############################
$nprotosref = XB_XML_create_node_def (
[
$nprotoname, # net prototype name
\$ifacesstr, # export exp_0
$vnodeslref, # vnodes for star network
$linkslref, # links that form star network
[ # node_def properties
'IPsec_authentication' => $ahref->{IPsec_authentication},
'dns' => $ahref->{dns},
'dynamic_routing' => $ahref->{dynamic_routing},
'IPsec_encryption' => $ahref->{IPsec_encryption},
'address_type' => $ahref->{address_type},
'deployment' => $ahref->{deployment}
],
$appstrr
],
$indent);
$string .= $$nprotosref;
return (\$string);
};
###################################################################
#
# XB_create_topology_custom_msg ( ahref, indent )
#
# Creates the nodelist, linklist and netlist parts of a network, using a
# netlist description string passed by reference in nlsref.
#
# The netlist description string is a sequence of node pairs, one pair per
# line. A full-duplex link is presumed to exist between both nodes in each
# pair. Example:
# center tom
# center dick
# center harry
#
# This specifies a star network, with the router node named 'center'
# connected to three hosts that are named tom, dick and harry.
#
# The links and interfaces needed to create a complete XOL overlay
# specification are a automatically created and named.
#
# A reference to the program string created is returned.
###################################################################
# node_def ( name ifacesref linksref vnodesref propstrref )
#
# name ---- string ident
# ifaces -- see XB_XML_create_interfaces()
# vnodes -- see XB_XML_create_vnodes()
# links -- see XB_create_netlist()
# propstr - see XB_XML_create_property_elements()
#
# interfaces ( name, ifplref, name, ifplref ... )
# netlist ( [nodename iface linkname nodename iface] ... )
# vnodes [ [identity, type, name, value, name, value, ...] ..... ]
sub XB_create_topology_custom_msg ($;$)
{
my ($ahref, $indent) = @_;
my ($string, $nlsref, $oslref, $nprotoname, $ix, $line, @lines);
my ($node, %nodes, $ifcnt, $ifaceslref, $sref, $vnodeslref, @links, $nprotosref);
my ($link, $linkslref, $nxt_indent, %protos, $hprotoname, $hprotosref, $ifacesstr);
if (!defined ($indent)) { $indent = ''; };
$nxt_indent = ' ' . $indent;
$string = '';
########################
# Generate hash of nodes
# key is node name
# value is iface count
########################
@lines = split /\n+/, $ahref->{custom_netlist};
%nodes = ();
foreach $line (@lines)
{
$_ = $line;
@links = split;
if (scalar (@links) != 2) # Discard bad specification lines
{ next; };
foreach $node (@links)
{
if (!defined ($nodes{$node})) # Count interfaces per node
{ $nodes{$node} = 1; }
else
{ $nodes{$node}++; };
};
};
#############################
# Generate hash of prototypes
# key is iface count
# value is node_def name
#############################
%protos = ();
foreach $node (keys (%nodes))
{
$ifcnt = $nodes{$node};
if (!defined ($protos{$ifcnt}))
{ $protos{$ifcnt} = "custom_$ifcnt"; };
};
##########################################
# Generate needed node_defs for prototypes
##########################################
foreach $ifcnt (keys (%protos))
{
$ifcnt = int ($ifcnt);
$hprotoname = "custom_$ifcnt";
$ifaceslref = [];
for ($ix = 0; $ix < $ifcnt; $ix++)
{
push (@$ifaceslref, "if_$ix");
push (@$ifaceslref, []); # no iface props
};
if ($ifcnt > 1)
{
$oslref = [ 'os' => $ahref->{router_os}];
push (@$ifaceslref, 'exp_0'); # provide export iface to routers
push (@$ifaceslref, []);
}
else
{ $oslref = [ 'os' => $ahref->{host_os}]; };
$hprotosref = XB_XML_create_node_def (
[
$hprotoname, # prototype name
$ifaceslref, # interfaces for prototype
[], # no vnodes for prototype
[], # no link for prototype
$oslref, # host or router os
[]
],
$indent);
$string .= $$hprotosref;
};
#################################
# Now create the node_def element
# for the custom network itself
#################################
$nprotoname = $ahref->{topology};
#######################################
# Create the exported iface using
# 'router_0', 'exp_0'
#######################################
foreach $ifcnt (keys (%protos))
{
$ifcnt = int ($ifcnt);
if ($ifcnt > 1)
{
$sref = XB_XML_create_renamed_interface (
'exp_0',
[ $protos{$ifcnt}, 'exp_0' ],
$nxt_indent
);
last;
};
};
$ifacesstr = $$sref;
###################
# Create the vnodes
###################
$vnodeslref = [];
foreach $node (keys (%nodes))
{
$ifcnt = $nodes{$node};
push (@$vnodeslref, [ $node, $protos{$ifcnt} ] );
};
##################
# Create the links
##################
$link = 0;
$linkslref = [];
foreach $line (@lines)
{
my ($right, $left, $rightif, $leftif);
$_ = $line;
@links = split;
if (scalar (@links) != 2) # Discard bad specification lines
{ next; };
$left = shift (@links); # Names of link endpoint nodes
$right = shift (@links);
$leftif = --$nodes{$left}; # Consume a node iface
$rightif = --$nodes{$right};
push (@$linkslref, [ "$left", "if_$leftif",
"link_$link", "$right", "if_$rightif" ] );
$link++;
};
# Check if application deployment
my $appstrr;
if(defined ($ahref->{application})){
$appstrr = XB_XML_GUI::XB_create_application(
$ahref->{application}, $nxt_indent);
}else{
$appstrr = '';
}
############################
# Build the node_def element
############################
$nprotosref = XB_XML_create_node_def (
[
$nprotoname, # net prototype name
\$ifacesstr, # export exp_0
$vnodeslref, # vnodes for star network
$linkslref, # links that form star network
[ # node_def properties
'IPsec_authentication' => $ahref->{IPsec_authentication},
'dns' => $ahref->{dns},
'dynamic_routing' => $ahref->{dynamic_routing},
'IPsec_encryption' => $ahref->{IPsec_encryption},
'address_type' => $ahref->{address_type},
'deployment' => $ahref->{deployment}
],
$appstrr
],
$indent);
$string .= $$nprotosref;
return (\$string);
};
#'address_type' 'IPv4' or 'IPv6'
#
#'auth_type' x509
#
#'class' host | router | both
#
#'command' one of the command elements, i.e. 'create_overlay'
#
#'creator_name' /^[A-Z. \'\-]+$/i
#
#'creator_email' /^[A-Z0-9_\.]+@[A-Z0-9-_\.]+$/i
#
#'dynamic_routing' yes | no
#
#'hosts' non-negative integer
#'interfaces' non-negative integer
#
#'ip_address' IPv4 'w.x.y.z' each field 0-255
#'local_ip_addr' or IPv6 syntax, 1-8 fields separated by ':', 1-4 hex digits
#'remote_ip_addr
#
#'IPsec_encryption' des | 3des | none
#
#'IPsec_authentication' md5 | sha1 | none
#
#'max_interfaces' non-negative integer
#'max_overlays' non-negative integer
#'max_tunnels' non-negative integer
#'node_count' non-negative integer
#
#'os' FreeBSD | Linux
#'host_os'
#'router_os'
#
#'overlays' non-negative integer
#
#'protocol' 'number.alphanumeric'
#
#'release' 'number.alphanumeric'
#
#'routers' non-negative integer
#
#'search_radius' non-negative integer
#
#'status' up | down
#
#'timeout' non-negative integer
#
#'topology' ring | linear | star | custom
#
#'tunnel_count' non-negative integer
#
#'two_phase' yes | no
#use XB_XML_scan;
#my $sref;
#
#$sref = \"
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#
#";
#
#
#$_ = XB_XML_scan::XB_XML_parse ($sref);
#
#if ($_)
# {
# print STDERR "\n\nFAILURE:\n$_\n$_\n\n";
# $_ = XB_XML_scan::XB_XML_choose_parse_error ($_);
# print STDERR "CHOSEN ERROR STRING: $_\n\n";
# exit (1);
# }
#else
# { print "SUCCESS SUCCESS\n\n"; exit (1); };
#
#
#use XB_XML_scan;
#my $sref;
#
#my ($href, $ahref, $nodeslref);
#my ($cmdhref, $covlhref, $xolhref);
#
#$ahref = { 'user_name' => "finn",
# 'user_email' => "finn\@isi.edu",
# 'auth_type' => "x509",
# 'overlay_name' => 'testnet',
# 'IPsec_authentication' => '3des',
# 'IPsec_encryption' => '3des',
# 'topology' => 'linear',
# 'hosts' => 2,
# 'routers' => 2,
# 'os' => 'FreeBSD Linux',
# 'dns' => 'yes',
# 'host_os' => 'FreeBSD',
# 'router_os' => 'Linux',
# 'ip_address' => '10.2.43.122',
# 'local_ip_address' => '10.2.43.122',
# 'remote_ip_address' => '1:2344:ab34:34',
# 'search_radius' => 4,
# 'manager' => 'pbs.isi.edu',
# 'manager_port' => 3453,
# 'name_server' => 'cnn.isi.edu',
# 'name_server_port' => 8535,
# 'address_type' => 'IPv4',
# 'address_server' => 'rum.isi.edu',
# 'address_server_port' => 2189,
## 'dummynet' => 'yes',
## 'dummynet_bandwidth' => 450000,
## 'dummynet_bandwidth_unit' => 1024,
## 'dummynet_delay' => 4321,
## 'dummynet_queue' => 21,
## 'dummynet_queue_unit' => 1,
## 'dummynet_loss_rate' => 30,
## 'application' => 'program name',
## 'application_script' => 'script for application program',
# 'custom_hostlist' => 'banana alpha beta',
# 'custom_netlist' =>
# 'able xray
# baker xray
# charlie xray
# xray zero
# dog zero
# easy zero'
# };
#
#$nodeslref = [
# [ 'class' => 'host',
# 'name_server' => 'foo.blah.net',
# 'ip_address' => '10.12.0.42',
# 'os' => 'FreeBSD',
# 'status ' => 'up',
# 'interfaces' => 1
# ],
# [ 'class' => 'router',
# 'name_server' => 'foobar.blah.net',
# 'ip_address' => '10.12.0.43',
# 'os' => 'Linux',
# 'status' => 'up',
# 'interfaces' => 3,
# 'tunnels' => [
# [
# 'local_ip_address' => '10.12.0.46',
# 'remote_ip_address' => '124.0.54.16',
# 'status' => 'up'
# ],
# [
# 'local_ip_address' => '10.12.0.47',
# 'remote_ip_address' => '37.0.12.61',
# 'status' => 'up'
# ],
# [
# 'local_ip_address' => '10.12.0.48',
# 'remote_ip_address' => '113.0.75.6',
# 'status' => 'up'
# ]
# ]
# ]
# ];
#
#
#
##$sref = XB_build_create_overlay_msg ( $ahref );
##$sref = XB_build_create_overlay_reply_msg ( $ahref, $nodeslref );
#
##$sref = XB_build_list_overlays_msg ( $ahref );
##$sref = XB_build_list_overlays_reply_msg ( $ahref, \'foo.xbone.net bar.xbone.net' );
#
##$sref = XB_build_destroyall_overlays_msg ( $ahref );
##$sref = XB_build_destroyall_overlays_reply_msg ($ahref, 'Ok');
#
#$sref = XB_build_discover_daemons_msg ($ahref);
##$sref = XB_build_discover_daemons_reply_msg ($ahref, $nodeslref);
#
##$sref = XB_build_overlay_status_msg ($ahref);
##$sref = XB_build_overlay_status_reply_msg ($ahref, $nodeslref);
#
##$sref = XB_build_destroy_overlay_msg ($ahref);
##$sref = XB_build_destroy_overlay_reply_msg ($ahref, 'testnet');
#
##$sref = XB_build_api_errmsg ($ahref, 'Message with < and " and \' and & and > chars');
#
#
#
#print "\n\t\tCREATE MESSAGE\n";
#print "\t\tCREATE MESSAGE\n";
#print "\t\tCREATE MESSAGE\n\n$$sref\n\f";
#
#
#$_ = XB_XML_scan::XB_XML_parse ($sref);
#
#if ($_)
# {
# print STDERR "\n\nFAILURE:\n$_\n$_\n\n";
# $_ = XB_XML_scan::XB_XML_choose_parse_error ($_);
# print STDERR "CHOSEN ERROR STRING: $_\n\n";
# exit (1);
# };
#
#$href = XB_XML_scan::XB_XML_hash ($sref);
#
#$_ = Dumper ($href);
#
#print "\n\tCREATE MESSAGE AFTER HASHING\n";
#print "\tCREATE MESSAGE AFTER HASHING\n";
#print "\tCREATE MESSAGE AFTER HASHING\n\n$_";
#
#$cmdhref = $href->{command};
#$covlhref = $cmdhref->{create_overlay};
#$xolhref = $covlhref->{xol_program};
#
#XB_XML_scan::XB_XOL_xbone_list_sub ($href);
#
#$_ = Dumper ($href);
#
#print "\n\tCREATE MESSAGE AFTER LIST SUBSTITUTION\n";
#print "\tCREATE MESSAGE AFTER LIST SUBSTITUTION\n";
#print "\tCREATE MESSAGE AFTER LIST SUBSTITUTION\n\n$_";
#
#XB_XML_scan::XB_XOL_synonym_sub ($href, $xolhref->{define_prop});
#
#$_ = Dumper ($href);
#
#print "\n\tCREATE MESSAGE AFTER PARSE & DATA STRUCTURE SUBSTITUTIONS\n";
#print "\tCREATE MESSAGE AFTER PARSE & DATA STRUCTURE SUBSTITUTIONS\n";
#print "\tCREATE MESSAGE AFTER PARSE & DATA STRUCTURE SUBSTITUTIONS\n\n$_\n";
#
#exit(1);
1; # Insure TRUE return if module is interpreted.