### 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 API utilities used only by the GUI
#
# Principal author: Gregory Finn
#
##################################################


package XB_API_GUI;


require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();


use strict;

use Data::Dumper;          # Used for debugging, comment out for release.

#use XB_Log;                # Problematic, logging from GUI not supported.

use XB_Params; 
use XB_XOL;

use Parse::RecDescent;






#######################################################################
#
# XB_build_create_overlay_msg ( ahref )
#
#######################################################################

sub XB_build_create_overlay_msg ($)
  {
    my  ( $ahref ) = @_;
    my ($string, $credential_ref, $program_ref, $indent, $nxt_indent);

    $indent = '   ';
    $nxt_indent = '   ' . $indent;

    $string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";

    $credential_ref = XB_XOL::XB_build_criterions (
				    'user_name', "'$ahref->{user_name}'",
				    'user_email', $ahref->{user_email},
				    'auth_type', $ahref->{auth_type}
				  );
    $string .= $indent . '(credential ' . $$credential_ref . ")\n";

    $string .= $indent . "(create_overlay  (search_radius $ahref->{search_radius})\n";

    $program_ref = XB_API_GUI::XB_build_xol_program_msg ($ahref, $nxt_indent);

    if (!defined ($program_ref))
      {
        #RETURN ERROR MESSAGE
      };

    $string .= $$program_ref;

    $string .= $indent . ")\n";		# End ( create_overlay

    $string .= ")\n";                   # End ( xbone

    return (\$string);
  }





#######################################################################
#
# XB_build_destroy_overlay_msg ( auth_type, overlay_name, user_name,
#   user_email)
#
#######################################################################

sub XB_build_destroy_overlay_msg ($$$$)
  {
    my ($auth_type, $overlay_name, $user_name, $user_email ) = @_;
    my ($string, $cs_ref, $credential_ref);

    $credential_ref = XB_XOL::XB_build_criterions (
      'user_name', "'$user_name'",
      'user_email',  $user_email,
      'auth_type',   $auth_type
    );
    $cs_ref = XB_XOL::XB_build_criterions (
      'auth_type',    $auth_type,
      'overlay_name', $overlay_name,
      'user_id',      $user_email
    );
    if (!defined ($cs_ref)) {
      #LOG FATAL ERROR MESSAGE
    };


    $string =  "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
    $string .= '  (credential '. $$credential_ref. ")\n";
    $string .= "  (destroy_overlay ";
    $string .= $$cs_ref;
    $string .= ")\n";		# End ( destroy_overlay
    $string .= ")\n";		# End ( xbone
    #$string .= "XboneEOC\n";	# End record

    return (\$string);
  }





#######################################################################
#
# XB_build_overlay_status_msg ( auth_type, overlay_name, search_radius, user_id )
#
#######################################################################

sub XB_build_overlay_status_msg ($$$$)
  {
    my ($auth_type, $overlay_name, $search_radius, $user_id) = @_;
    my ($string, $cs_ref);

    $string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
    $string .= "\t(overlay_status ";

    $cs_ref = XB_XOL::XB_build_criterions ( 'auth_type', $auth_type,
					    'overlay_name', $overlay_name,
					    'search_radius', $search_radius,
					    'user_id', $user_id
					  );

    if (!defined ($cs_ref))
      {
	#LOG FATAL ERROR MESSAGE
      };

    $string .= $$cs_ref;

    $string .= ")\n";		# End ( overlay_status

    $string .= ")\n";		# End ( xbone

    $string .= "XboneEOC\n";	# End record

    return (\$string);
  }





#######################################################################
#
# XB_build_discover_daemons_msg ( auth_type, creator_name, creator_email,
#				  search_radius, timeout, user_id )
#
#######################################################################

sub XB_build_discover_daemons_msg ($$$$$$)
  {
    my ($auth_type, $creator_name, $creator_email, $search_radius,
	$timeout, $user_id ) = @_;    my ($string, $cs_ref);

    $string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
    $string .= "\t(discover_daemons ";

    $cs_ref = XB_XOL::XB_build_criterions ( 'auth_type', $auth_type,
					    'creator_name', $creator_name,
					    'creator_email', $creator_email,
					    'search_radius', $search_radius,
					    'timeout', $timeout,
					    'user_id', $user_id
					  );

    if (!defined ($cs_ref))
      {
	#LOG FATAL ERROR MESSAGE
      };

    $string .= $$cs_ref;

    $string .= ")\n";		# End ( discover_daemons

    $string .= ")\n";		# End ( xbone

    $string .= "XboneEOC\n";	# End record

    return (\$string);
  }






#######################################################################
#
# XB_build_destroyall_overlays_msg ( auth_type, user_id )
#
#######################################################################

sub XB_build_destroyall_overlays_msg ($$)
  {
    my ($auth_type, $user_id) = @_;  my ($string, $cs_ref);

    $string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
    $string .= "\t(destroyall_overlays ";

    $cs_ref = XB_XOL::XB_build_criterions ( 'auth_type', $auth_type,
					    'user_id', $user_id
					  );
    if (!defined ($cs_ref))
      {
	#LOG FATAL ERROR MESSAGE
      };

    $string .= $$cs_ref;

    $string .= ")\n";		# End ( destroyall_overlays

    $string .= ")\n";		# End ( xbone

    $string .= "XboneEOC\n";	# End record

    return (\$string);
  }






#######################################################################
#
# XB_build_list_overlays_msg ( auth_type, user_name, user_email )
#
#######################################################################

sub XB_build_list_overlays_msg ($$$)
  {
    my ($auth_type, $user_name, $user_email) = @_;
    my ($string, $credential_ref, $cs_ref);


    $credential_ref = XB_XOL::XB_build_criterions (
      'user_name', "'$user_name'",
      'user_email',  $user_email,
      'auth_type',   $auth_type
    );
    $cs_ref = XB_XOL::XB_build_criterions ( 'auth_type', $auth_type,
                                            'user_id',   $user_email
                                          );
    if (!defined ($cs_ref)){
      #LOG FATAL ERROR MESSAGE
    };

    $string =  "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
    $string .= "  (credential ". $$credential_ref. ")\n";
    $string .= "  (list_overlays ";
    $string .= $$cs_ref;
    $string .= ")\n";		# End ( list_overlays
    $string .= ")\n";		# End ( xbone
    #$string .= "XboneEOC\n";	# End record

    return (\$string);
  }




######################################################################
#
# sub XB_check_create_reply ( chref )
#
######################################################################

sub XB_check_create_reply ($)
  {
    my ($chref) = @_;
    my ($key, $retval);

    my @create_reply_keys = ('command', 'error');

    ##################################
    # Perform keyword existence checks
    ##################################

	
    if (!defined ($chref->{error}))
      {
	@create_reply_keys = ('command', 'user_id', 'overlay_name',
			      'creator_name', 'creator_email', 'topology',
			      'auth_type', 'nodes');
      };

    foreach $key (@create_reply_keys)
    {
      if (!exists ($chref->{$key}))
	{  return ("Missing $key keyword in create_reply\n");  };
    };

    ##############################
    # Perform keyword value checks
    ##############################

    $retval = XB_XOL::XB_check_criterion_values ($chref, @create_reply_keys);
    if ($retval)
      { return ($retval); };

    return (0);
  }




######################################################################
#
# sub XB_check_list_overlays_reply ( chref )
#
######################################################################

sub XB_check_list_overlays_reply ($)
  {
    my ($chref) = @_;
    my ($key);

    my @list_overlays_reply_keys = ('command', 'overlays');

    ##################################
    # Perform keyword existence checks
    ##################################

    foreach $key (@list_overlays_reply_keys)
    {
      if (!exists ($chref->{$key}))
	{  return ("Missing $key keyword in list_overlays_reply\n");  };
    };

    ##############################
    # Perform keyword value checks
    ##############################

    if ($chref->{command} !~ /^list_overlays_reply$/)
      { return ("Command must be list_overlays_reply\n"); }

    $key = ref ($chref->{overlays});
    if ($key ne 'ARRAY')
      { return ("overlays value must be a list of names\n"); }

    return (0);
  }





######################################################################
#
# sub XB_check_overlay_status_reply ( chref )
#
######################################################################

sub XB_check_overlay_status_reply ($)
  {
    my ($chref) = @_;
    my ($key, $retval);

    my @overlay_status_reply_keys = ('command', 'user_id', 'auth_type',
				     'creator_name', 'creator_email',
				     'overlay_name', 'topology', 'authentication',
				     'encryption');

    ##################################
    # Perform keyword existence checks
    ##################################

    foreach $key (@overlay_status_reply_keys)
    {
      if (!exists ($chref->{$key}))
	{  return ("Missing $key keyword in overlay_status_reply\n");	};
    };

    ##############################
    # Perform keyword value checks
    ##############################

    if ($chref->{command} !~ /^overlay_status_reply$/)
      { return ("Command must be overlay_status_reply\n"); }
    else
      {  shift (@overlay_status_reply_keys);  }	# command value has been checked

    $retval = XB_XOL::XB_check_criterion_values ( $chref,
						  @overlay_status_reply_keys );
    if ($retval)
      { return ($retval); };

    return (0);
  }





######################################################################
#
# sub XB_check_discover_daemons_reply ( chref )
#
######################################################################

sub XB_check_discover_daemons_reply ($)
  {
    my ($chref) = @_;
    my ($key, $retval);

    my @discover_reply_keys = ('command', 'user_id', 'auth_type',
			       'creator_name', 'creator_email');

    ##################################
    # Perform keyword existence checks
    ##################################

    foreach $key (@discover_reply_keys)
    {
      if (!exists ($chref->{$key}))
	{  return ("Missing $key keyword in discover_reply\n");	};
    };

    ##############################
    # Perform keyword value checks
    ##############################

    if ($chref->{command} !~ /^discover_daemons_reply$/)
      { return ("Command must be discover_daemons_reply\n"); }
    else
      {  shift (@discover_reply_keys);  }	# command value has been checked

    $retval = XB_XOL::XB_check_criterion_values ( $chref,
						  @discover_reply_keys );
    if ($retval)
      { return ($retval); };

    return (0);
  }





######################################################################
#
# sub XB_check_destroy_overlay_reply ( chref )
#
######################################################################

sub XB_check_destroy_overlay_reply ($)
  {
    my ($chref) = @_;
    my ($key, $retval);

    my @destroy_overlay_reply_keys = ('command', 'overlay_name');

    ##################################
    # Perform keyword existence checks
    ##################################

    foreach $key (@destroy_overlay_reply_keys)
    {
      if (!exists ($chref->{$key}))
	{  return ("Missing $key keyword in destory_overlay_reply\n");	};
    };

    ##############################
    # Perform keyword value checks
    ##############################

    if ($chref->{command} !~ /^destroy_overlay_reply$/)
      { return ("Command must be destroy_overlay_reply\n"); }
    else
      {  shift (@destroy_overlay_reply_keys);  }	# command checked

    $retval = XB_XOL::XB_check_criterion_values ( $chref,
						  @destroy_overlay_reply_keys );
    if ($retval)
      {  return ($retval);  }

    return (0);
  }





######################################################################
#
# sub XB_check_destroyall_overlays_reply ( chref )
#
######################################################################

sub XB_check_destroyall_overlays_reply ($)
  {
    my ($chref) = @_;
    my ($key, $retval);

    my @destroyall_overlays_reply_keys = ('command', 'message');

    ##################################
    # Perform keyword existence checks
    ##################################

    foreach $key (@destroyall_overlays_reply_keys)
    {
      if (!exists ($chref->{$key}))
	{  return ("Missing $key keyword in destoryall_overlays_reply\n");	};
    };

    ##############################
    # Perform keyword value checks
    ##############################

    if ($chref->{command} !~ /^destroyall_overlays_reply$/)
      { return ("Command must be destroyall_overlays_reply\n"); }
    else
      {  shift (@destroyall_overlays_reply_keys);  }	# command value checked

    $retval = XB_XOL::XB_check_criterion_values ( $chref,
						  @destroyall_overlays_reply_keys );
    if ($retval)
      { return ($retval); };

    return (0);
  }





######################################################################
#
# sub XB_check_node ( href )
#
######################################################################

sub XB_check_node ($)
  {
    my ($href) = @_;  my ($key, $thref, $retval);

    my @node_keys =  ('os', 'ip_address', 'class');

    ##################################
    # Perform keyword existence checks
    ##################################

    foreach $key (@node_keys)
      {
	if (!exists ($href->{$key}))
	  {  return ("Missing $key keyword in node specification\n");  };
      };

    ##############################
    # Perform keyword value checks
    # Add optional key/value pairs
    ##############################

    push (@node_keys, ('authentication', 'class', 'dns_name', 'dynamic_routing',
	  'encryption', 'interfaces', 'ip_address', 'max_interfaces',
	  'max_overlays', 'os', 'overlays', 'release', 'max_tunnels',
	  'tunnel_count') );

    $retval = XB_XOL::XB_check_criterion_values ($href, @node_keys);
    if ($retval)
      { return ($retval); };

    return (0);
  }





######################################################################
#
# sub XB_check_tunnel ( href )
#
######################################################################

sub XB_check_tunnel ($)
  {
    my ($href) = @_;  my ($key, $retval);

    my @tunnel_keys =  ('local_ip_address', 'remote_ip_address', 'status');

    ##################################
    # Perform keyword existence checks
    ##################################

    foreach $key (@tunnel_keys)
      {
	if (!exists ($href->{$key}))
	  {  return ("Missing $key keyword in tunnel specification\n");  };
      };

    ##############################
    # Perform keyword value checks
    ##############################

    $retval = XB_XOL::XB_check_criterion_values ($href, @tunnel_keys);
    if ($retval)
      { return ($retval); };


    return (0);
  }





#######################################################################
#
# 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 . "(xol $XB_Params::xol_ver\n";

    $omref = XB_build_class_msg ($ahref, $nxt_indent);
    if (!defined ($omref))
      {
        #RETURN ERROR MESSAGE
      };

    $string .= $$omref;

    ##################
    # root declaration
    ##################

    $string .= $nxt_indent . "(root $ahref->{topology} $ahref->{overlay_name})\n";

    $string .= $indent . ")\n";		# End ( xol

    return (\$string);
  }




#######################################################################
#
# XB_build_class_msg ( ahref, indent )
#
#######################################################################

sub XB_build_class_msg ($;$)
  {
    my ($ahref, $indent) = @_;
    my ($string, $sref, $ix, $nxt_indent);

    if (!defined ($indent))
      { $indent = ''; };
    $nxt_indent = '   ' . "$indent";

    $string = $indent . "(class $ahref->{topology} \n";

    ##########################
    # build ( netprops portion
    ##########################

    $sref = XB_XOL::XB_build_criterions (
		    'IPsec_authentication', $ahref->{IPsec_authentication},
                    'dns', $ahref->{dns},
                    'dynamic_routing', $ahref->{dynamic_routing},
                    'IPsec_encryption', $ahref->{IPsec_encryption},
                    'addresstype', 'ipv4'
                                        );

    $string .= $nxt_indent . "(netprops $$sref )\n";

    ############################
    # Generate simple nets parts
    ############################

    $sref = XB_create_net_topology ( $ahref, $nxt_indent );

    $string .= $$sref;

    ######################
    # exportlist is empty
    ######################

    $string .= $nxt_indent . "(exportlist )\n";

    $string .= $indent . ")\n";		# End ( class

    return (\$string);
  }





#######################################################################
#
# XB_build_application_msg ( program_sref, params_sref )
#
# program_sref is a reference to a string that contains the program name.
# params_sref is a reference to a string that contains several arguments
# separated by whitespace.
#######################################################################

sub XB_build_application_msg ($$)
  {
    my ($program_sref, $params_sref ) = @_;
    my ($string);

    $string = ' (application ';

    $string .= $$program_sref . ' ' . XB_XOL::XB_qstring ($$params_sref);

    $string .= ")\n";		# End ( application

    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->{hosts},
						 $ahref->{host_os},
						 $ahref->{router_os}, $indent );
      }
    elsif ($type eq 'linear')
      {	$result = XB_create_topology_line_msg ( $ahref->{hosts},
					        $ahref->{host_os},
                                                $ahref->{routers},
					        $ahref->{router_os}, $indent );
      }
    elsif ($type eq 'ring')
      {  $result = XB_create_topology_ring_msg ( $ahref->{hosts},
						 $ahref->{host_os},
						 $ahref->{routers},
						 $ahref->{router_os}, $indent );
       }
    elsif ($type eq 'custom')
      {  $result = XB_create_topology_custom_msg ( \$ahref->{custom_netlist},
						   $ahref->{host_os},
						   $ahref->{router_os}, $indent );
       }
    else
      { die ("Unknown network type:$type passed"); };	  # Unknown network topology

    return ($result);
  }





###################################################################
#
# XB_create_nodeprops ( npsref, indent )
#
# nplref is a reference to a list ( name, value, name, value ...) strings
# that are turned into a sequence CRITERION rules.
#
# Returns a reference to a (node ... ) string.
###################################################################

sub XB_create_nodeprops ($;$)
  {
    my ($npsref, $indent) = @_;
    my ($string, $strref);

    if (!defined ($indent))
      { $indent = ''; };

    $strref = XB_XOL::XB_build_criterions (@$npsref);
    $string = "$indent" . '(nodeprops' . $$strref . ')';

    return (\$string);
  }




###################################################################
#
# XB_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 an (interfaces ... ) string.
###################################################################

sub XB_create_interfaces ($;$)
  {
    my ($iflref, $indent) = @_;
    my ($string, $ifname, $ifplref, $nxt_indent, $strref);

    if (!defined ($indent))
      { $indent = ''; };
    $nxt_indent = '   ' . "$indent";

    $string = "$indent(interfaces\n";

    $ifname = shift (@$iflref);        # Get first interface name
    while (defined ($ifname))
      {
	$ifplref = shift (@$iflref);   # Get interface properties

	$strref = XB_create_interface ($ifname, $ifplref);
	$string .= $nxt_indent . $$strref . "\n";

	$ifname = shift (@$iflref);    # Get next interface name
      };

    $string .= "$indent)";

    return (\$string);
  }




###################################################################
#
# XB_create_interface ( ifname, ifplref )
#
# 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 an (interface ... ) string.
###################################################################

sub XB_create_interface ($$;$)
  {
    my ($ifname, $ifplref) = @_;
    my ($string, $strref);

    $strref = XB_XOL::XB_build_criterions (@$ifplref);
    $string = '(interface ' . $ifname . $$strref . ')';

    return (\$string);
  }





###################################################################
#
# XB_create_node ( nref, indent )
#
# nref is a reference to a list of information associated with a node.
# It takes the format ( name props ifaces )
#                       name ---- string name
#                       propstr - see XB_create_nodeprops()
#                       ifaces -- see XB_create_interfaces()
#
# Returns a reference to a (node ... ) string.
###################################################################

sub XB_create_node ($;$)
{
    my  ($nref, $indent) = @_;
    my ($string, $strref, $nxt_indent);

    if (!defined ($indent))
      { $indent = ''; };
    $nxt_indent = '   ' . "$indent";

    $string = "$indent" . '(node ' . $nref->[0] . "\n";

    $strref = XB_create_nodeprops ($nref->[1], $nxt_indent);
    $string .= $$strref . "\n";

    $strref = XB_create_interfaces ($nref->[2], $nxt_indent);
    $string .= $$strref . "\n";

    $string .= "$indent)\n";

    return (\$string);
}




###################################################################
#
# XB_create_nodelist ( nlref, indent )
#
# Returns a reference to a (nodelist ... ) string.
###################################################################

sub XB_create_nodelist ($;$)
{
    my  ($nlref, $indent) = @_;
    my ($string, $strref, $nref, $nxt_indent);

    if (!defined ($indent))
      { $indent = ''; };
    $nxt_indent = '   ' . "$indent";

    $string = "$indent(nodelist\n";

    foreach $nref (@$nlref)
      {
	$strref = XB_create_node ($nref, $nxt_indent);
	$string .= $$strref;
      };

    $string .= "$indent)\n";

    return (\$string);
}





###################################################################
#
# XB_create_linklist ( linkslref, indent )
#
# linkslref references a list of the form:
#          ( linkname (--) linkname (--) ...)
#    where (--) is the criteria list associated with the preceeding
#    named link, taking the form ( name, value, name, value ... )
#
# Returns a reference to a (linklist ... ) string.
###################################################################

sub XB_create_linklist ($;$)
{
    my  ($linkslref, $indent) = @_;
    my ($string, $strref, $linkname, $clref, $nxt_indent);

    if (!defined ($indent))
      { $indent = ''; };
    $nxt_indent = '   ' . "$indent";

    $string = "$indent(linklist\n";

    $linkname = shift (@$linkslref);
    while (defined ($linkname))
      {
	$clref = shift (@$linkslref);
	$strref = XB_create_link ($linkname, $clref, $nxt_indent);
	$string .= $$strref . "\n";
        $linkname = shift (@$linkslref);
      };

    $string .= "$indent)\n";

    return (\$string);
}





###################################################################
#
# XB_create_link ( linkname, clref, indent )
#
# linkname names a link, clref references the criteria for this link.
# The clref list takes the form ( name, value, name, value ... )
#
# Returns a reference to a (link ... ) string.
###################################################################

sub XB_create_link ($$;$)
{
    my  ($linkname, $clref, $indent) = @_;
    my ($string, $strref);

    if (!defined ($indent))
      { $indent = ''; };

    $string = "$indent(link $linkname";
    $strref = XB_XOL::XB_build_criterions (@$clref);
    $string .= "$$strref)";

    return (\$string);
}





###################################################################
#
# XB_create_netlist ( linkslref, indent )
#
# linkslref references a list of the form:
#   ( (nodename linkname nodename) ... (nodename linkname nodename) )
#
#    where each triple indicates that the named link connects the two
#    named nodes.
#
# Returns a reference to a (linklist ... ) string.
###################################################################

sub XB_create_netlist ($;$)
{
    my  ($linkslref, $indent) = @_;
    my ($string, $strref, $lref, $nxt_indent);

    if (!defined ($indent))
      { $indent = ''; };
    $nxt_indent = '   ' . $indent;

    $string = "$indent(netlist\n";

    $lref = shift (@$linkslref);
    while (defined ($lref))
      {
	$string .= $nxt_indent . "($lref->[0] $lref->[1] $lref->[2])\n";
        $lref = shift (@$linkslref);
      };

    $string .= "$indent)\n";

    return (\$string);
}





###################################################################
#
# XB_create_topology_star_msg ( hosts, host_os, router_os, indent )
#
# Creates the nodelist, linklist and netlist parts of a star network.
# The hosts argument specifies the number of hosts attached to a router.
# One router is created.  Interface, router and host names are picked
# by this routine.  The router_os and host_os are the names of the
# operating systems for the respective router and hosts.
#
# A reference to the program string created is returned.
###################################################################

sub XB_create_topology_star_msg ($$$;$)
{
    my ($hosts, $host_os, $router_os, $indent) = @_;
    my ($string, $nodeslref, $rmref, $ix);
    my ($nodelref, $nodename, $ifname, $ifaceslref, $ifproplref, $linkslref, $linkname);

    if (!defined ($indent))
      { $indent = ''; };

    #########################
    # Create host information
    #########################

    $nodeslref = [];
    for ($ix = 0;  $ix < $hosts;  $ix++)
      {
	$nodelref = [];
	$nodename = "host_$ix";

	$ifaceslref = [];
        $ifname = "if_0";	# No per-interface properties
	$ifproplref = [];
	push (@$ifaceslref, $ifname);
	push (@$ifaceslref, $ifproplref);

	push (@$nodelref, $nodename);
	push (@$nodelref, ['os', $host_os] );
	push (@$nodelref, $ifaceslref);

	push (@$nodeslref, $nodelref)
      }

    ########################
    # Add one router to that
    ########################

    $nodelref = [];
    $nodename = "router_0";

    $ifaceslref = [];
    for ($ix = 0;  $ix < $hosts;  $ix++)
      {
	$ifname = "if_$ix";  	# No per-interface properties
	push (@$ifaceslref, $ifname);
	push (@$ifaceslref, []);
      }

    push (@$nodelref, $nodename);
    push (@$nodelref, ['os', $router_os] );
    push (@$nodelref, $ifaceslref);

    push (@$nodeslref, $nodelref);

    ############################
    # Create the ( nodelist part
    ############################

    $rmref = XB_create_nodelist ($nodeslref, $indent);
    $string = "$$rmref";

    #########################
    # Create link information
    #########################

    $linkslref = [];
    for ($ix = 0;  $ix < $hosts;  $ix++)
      {
        $linkname = "link_$ix";
	push (@$linkslref, $linkname);
	push (@$linkslref, []);	     # No per-link properties
      };

    ############################
    # Create the ( linklist part
    ############################

    $rmref = XB_create_linklist ($linkslref, $indent);
    $string .= "$$rmref";

    ################################
    # Create the netlist information
    ################################

    $linkslref = [];
    for ($ix = 0;  $ix < $hosts;  $ix++)
      {
        $linkname = "link_$ix";
	$nodename = "host_$ix.if_0";
	push (@$linkslref, [ $nodename, $linkname, "router_0.if_$ix" ] );
      };

    ############################
    # Create the ( netlist part
    ############################

    $rmref = XB_create_netlist ($linkslref, $indent);
    $string .= "$$rmref";

    return (\$string);
};





###################################################################
#
# XB_create_topology_line_msg ( hosts, host_os, routers, router_os, indent )
#
# Creates the nodelist, linklist and netlist parts of a line network.
# The arguments are the number of hosts, routers and their operating systems.
# Host, interface and link names will be picked by this routine.
#
# Hosts are attached to end routers in 50/50 split.
#
# A reference to the program string created is returned.
###################################################################

sub XB_create_topology_line_msg ($$$$;$)
{
    my ($hosts, $host_os, $routers, $router_os, $indent) = @_;
    my ($string, $nodeslref, $rmref, $ix, $left_hosts, $right_hosts, $linkname);
    my ($nodelref, $nodename, $ifname, $ifaceslref, $ifproplref, $linkslref);

    if (!defined ($indent))
      { $indent = ''; };

    #####################################
    # A one router line network is a star
    #####################################

    if ($routers == 1)
      {	return (XB_create_topology_star_msg ($hosts, $host_os, $router_os, $indent) ); };

    #########################
    # Create host information
    #########################

    $nodeslref = [];
    for ($ix = 0;  $ix < $hosts;  $ix++)
      {
	$nodelref = [];
	$nodename = "host_$ix";

	$ifaceslref = [];
        $ifname = "if_0";	# No per-interface properties
	$ifproplref = [];
	push (@$ifaceslref, $ifname);
	push (@$ifaceslref, $ifproplref);

	push (@$nodelref, $nodename);
	push (@$nodelref, ['os', $host_os] );
	push (@$nodelref, $ifaceslref);

	push (@$nodeslref, $nodelref)
      }

    ###############################
    # Create the router information
    # for any center routers.
    ###############################

    if ($routers > 2)
      {
	for ($ix = 1;  $ix < ($routers - 1);  $ix++)
	{
	  $nodelref = [];
	  $nodename = "router_$ix";

	  $ifaceslref = [];
	  $ifname = "if_0";            	# No per-interface properties
	  push (@$ifaceslref, $ifname);
	  push (@$ifaceslref, []);

	  $ifname = "if_1";
	  push (@$ifaceslref, $ifname);
	  push (@$ifaceslref, []);

	  push (@$nodelref, $nodename);
	  push (@$nodelref, ['os', $router_os] );
	  push (@$nodelref, $ifaceslref);

	  push (@$nodeslref, $nodelref);
	};
      };

    ###############################
    # Create the router information
    # for the two end routers.
    ###############################

    $nodelref = [];
    $nodename = "router_0";

    $left_hosts = $hosts >> 1;              # Interfaces needed for leftmost router - 1
    $right_hosts = $hosts - $left_hosts;    #     "        "     rightmost router - 1

    $ifaceslref = [];
    for ($ix = 0;  $ix <= $left_hosts;  $ix++)
      {
	  $ifname = "if_$ix";               # No per-interface properties
	  push (@$ifaceslref, $ifname);
	  push (@$ifaceslref, []);
      };

    push (@$nodelref, $nodename);
    push (@$nodelref, ['os', $router_os] );
    push (@$nodelref, $ifaceslref);

    push (@$nodeslref, $nodelref);

    $nodelref = [];
    $_ = $routers - 1;
    $nodename = "router_$_";
    $ifaceslref = [];
    for ($ix = 0;  $ix <= $right_hosts;  $ix++)
      {
	  $ifname = "if_$ix";               # No per-interface properties
	  push (@$ifaceslref, $ifname);
	  push (@$ifaceslref, []);
      };

    push (@$nodelref, $nodename);
    push (@$nodelref, ['os', $router_os] );
    push (@$nodelref, $ifaceslref);

    push (@$nodeslref, $nodelref);

    ############################
    # Create the ( nodelist part
    ############################

    $rmref = XB_create_nodelist ($nodeslref, $indent);
    $string = "$$rmref";

    #########################
    # Create link information
    #########################

    $linkslref = [];
    for ($ix = 0;  $ix < $hosts;  $ix++)
      {
        $linkname = "hlink_$ix";
	push (@$linkslref, $linkname);
	push (@$linkslref, []);  	     # No per-link properties
      };

    for ($ix = 0;  $ix < ($routers - 1);  $ix++)
      {
        $linkname = "rlink_$ix";
	push (@$linkslref, $linkname);
	push (@$linkslref, []);
      };

    ############################
    # Create the ( linklist part
    ############################

    $rmref = XB_create_linklist ($linkslref, $indent);
    $string .= "$$rmref";

    ################################
    # Create the netlist information
    ################################

    $linkslref = [];
    for ($ix = 0;  $ix < $left_hosts;  $ix++)     # Leftmost router - host links
      {
        $linkname = "hlink_$ix";
	$nodename = "host_$ix.if_0";
	push (@$linkslref, [ $nodename, $linkname, "router_0.if_$ix" ] );
      };

    for ($ix = 0;  $ix < $right_hosts;  $ix++)    # Rightmost router - host links
      {
	$_ = $ix + $left_hosts;
        $linkname = "hlink_$_";
	$nodename = "host_$_.if_0";
	$_ = $routers - 1;
	push (@$linkslref, [ $nodename, $linkname, "router_$_.if_$ix" ] );
      };

    ############################
    # Create netlist information
    # for any center routers.
    ############################

    if ($routers > 2)
      {
	for ($ix = 1;  $ix < ($routers - 2);  $ix++)
	{
	  $linkname = "rlink_$ix";
	  $_ = $ix + 1;
	  push (@$linkslref, [ "router_$ix.if_1", $linkname, "router_$_.if_0" ] );
	};
      };

    ############################
    # Create netlist information
    # for the leftmost router.
    ############################

    push (@$linkslref, [ "router_0.if_$left_hosts", 'rlink_0', "router_1.if_0" ] );
   

    ############################
    # Create netlist information
    # for the rightmost router.
    ############################

    $_ = $routers - 1;
    $linkname = $_ - 1;
    push (@$linkslref,
	  [ "router_$linkname.if_1", "rlink_$linkname", "router_$_.if_$right_hosts" ] );

    ############################
    # Create the ( netlist part
    ############################

    $rmref = XB_create_netlist ($linkslref, $indent);
    $string .= "$$rmref";

    return (\$string);
};





###################################################################
#
# XB_create_topology_ring_msg ( hosts, host_os, routers, router_os, indent )
#
# Creates the nodelist, linklist and netlist parts of a line network.
# The arguments are the number of hosts, routers and their operating systems.
# Host, interface and link names will be picked by this routine.
#
# Hosts are dealt around ring to routers.
#
# A reference to the program string created is returned.
###################################################################

sub XB_create_topology_ring_msg ($$$$;$)
{
    my ($hosts, $host_os, $routers, $router_os, $indent) = @_;
    my ($string, $nodeslref, $rmref, $ix, $linkname);
    my ($nodelref, $nodename, $ifname, $ifaceslref, $ifproplref, $linkslref);
    my ($avif, $avlink, $cycles);

    if (!defined ($indent))
      { $indent = ''; };

    #####################################
    # A one router ring network is a star
    #####################################

    if ($routers == 1)
      {	return (XB_create_topology_star_msg ($hosts, $host_os, $router_os, $indent) ); };

    #########################
    # Create host information
    #########################

    $nodeslref = [];
    for ($ix = 0;  $ix < $hosts;  $ix++)
      {
	$nodelref = [];
	$nodename = "host_$ix";

	$ifaceslref = [];
        $ifname = "if_0";	# No per-interface properties
	$ifproplref = [];
	push (@$ifaceslref, $ifname);
	push (@$ifaceslref, $ifproplref);

	push (@$nodelref, $nodename);
	push (@$nodelref, ['os', $host_os] );
	push (@$nodelref, $ifaceslref);

	push (@$nodeslref, $nodelref)
      };

    #######################
    # Add the router-router
    # interfaces
    #######################

    for ($ix = 0;  $ix < $routers;  $ix++)
      {
	$nodelref = [];
	$nodename = "router_$ix";

	$ifaceslref = [];
	push (@$ifaceslref, 'if_0');	# No per-interface properties
	push (@$ifaceslref, []);
	push (@$ifaceslref, 'if_1');
	push (@$ifaceslref, []);

        $cycles = int ($hosts / $routers);
	$avif = 2;

        while ($cycles > 0)
	  {
	    push (@$ifaceslref, "if_$avif");
	    push (@$ifaceslref, []);

	    $cycles--;
	    $avif++;
	  };

	$_ = $hosts % $routers;
	if ($_ && ($ix < $_))
	  {
	    push (@$ifaceslref, "if_$avif");
	    push (@$ifaceslref, []);
	  };

	push (@$nodelref, $nodename);
	push (@$nodelref, ['os', $router_os] );
	push (@$nodelref, $ifaceslref);

	push (@$nodeslref, $nodelref)
      };

    #####################
    # Add the router-host
    # interfaces
    #####################


    for ($ix = 0;  $ix < $hosts;  $ix++)    # Connect hosts to the ring
      {
	if (!($ix % $routers)) { $avif++; };

      };

    ############################
    # Create the ( nodelist part
    ############################

    $rmref = XB_create_nodelist ($nodeslref, $indent);
    $string = "$$rmref";

    #########################
    # Create link information
    #########################

    $linkslref = [];
    for ($ix = 0;  $ix < ($hosts + $routers);  $ix++)
      {
        $ifname = "link_$ix";
	push (@$linkslref, $ifname);
	push (@$linkslref, []);	     # No per-link properties
      };

    ############################
    # Create the ( linklist part
    ############################

    $rmref = XB_create_linklist ($linkslref, $indent);
    $string .= "$$rmref";

    ################################
    # Create the netlist information
    ################################

    $linkslref = [];
    for ($ix = 0;  $ix < $routers;  $ix++)    # Connect routers into a ring
      {
        $linkname = "link_$ix";
	$_ = ($ix + 1) % $routers;
	push (@$linkslref, [ "router_$ix.if_1", $linkname, "router_$_.if_0" ] );
      };

    $avif = 1;			            # Initialize counters, last router iface used
    $avlink = $routers;                     # Next available link

    for ($ix = 0;  $ix < $hosts;  $ix++)    # Connect hosts to the ring
      {
	if (!($ix % $routers)) { $avif++; };

        $linkname = "link_$ix";
	$_ = $ix % $routers;
	push (@$linkslref, [ "host_$ix.if_0", "link_$avlink", "router_$_.if_$avif" ] );

        $avlink++;
      };

    ############################
    # Create the ( netlist part
    ############################

    $rmref = XB_create_netlist ($linkslref, $indent);
    $string .= "$$rmref";

    return (\$string);
};






###################################################################
#
# XB_create_topology_custom_msg ( nlsref, host_os, router_os, 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.
###################################################################

sub XB_create_topology_custom_msg ($$$;$)
{
    my ($nlsref, $host_os, $router_os, $indent) = @_;
    my ($string, $linkcount);
    my (@lines, $line, $node, %nodes, @links);

    my ($nodeslref, $rmref, $ix);
    my ($nodelref, $nodename, $ifname, $ifaceslref, $ifproplref, $linkslref);

    if (!defined ($indent))
      { $indent = ''; };

    ################
    # Get link count
    ################

    @lines = split /\n+/, $$nlsref;
    $linkcount = scalar (@lines);

    ########################
    # Generate hash of nodes
    ########################

    %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}++; };
	  };
      };


    ####################################
    # Create host and router information
    ####################################

    $nodeslref = [];
    $ix = 0;
    foreach $node (keys (%nodes))
      {
	my $ifx;

	$nodelref = [];
	$ifaceslref = [];

	$ifx = 0;
	while ($ifx < $nodes{$node})
	  {
	    $ifproplref = [];       # No per-interface properties
	    $ifname = "if_$ifx";
	    push (@$ifaceslref, $ifname);
	    push (@$ifaceslref, $ifproplref);

	    $ifx++;
	  };

	push (@$nodelref, $node);
	if ($nodes{$node} == 1)
	  {  push (@$nodelref, ['os', $host_os] );  }
	else
	  {  push (@$nodelref, ['os', $router_os] );  };
	push (@$nodelref, $ifaceslref);

	push (@$nodeslref, $nodelref);

	$ix++;
      };


    ############################
    # Create the ( nodelist part
    ############################

    $rmref = XB_create_nodelist ($nodeslref, $indent);
    $string = "$$rmref";

    #########################
    # Create link information
    #########################

    $linkslref = [];
    for ($ix = 0;  $ix < $linkcount;  $ix++)
      {
        $ifname = "link_$ix";
	push (@$linkslref, $ifname);
	push (@$linkslref, []);	     # No per-link properties
      };

    ############################
    # Create the ( linklist part
    ############################

    $rmref = XB_create_linklist ($linkslref, $indent);
    $string .= "$$rmref";

    ################################
    # Create the netlist information
    ################################

    $linkslref = [];
    for ($ix = 0;  $ix < $linkcount;  $ix++)
      {
	$_ = $lines[$ix];
	@links = split;

	$nodes{$links[0]}--;	# Decrement interface counts for each node
	$nodes{$links[1]}--;    # since interfaces are named starting at zero.

	push (@$linkslref, [ "$links[0].if_$nodes{$links[0]} ", "link_$ix",
              " $links[1].if_$nodes{$links[1]}" ] );
      };

    ############################
    # Create the ( netlist part
    ############################

    $rmref = XB_create_netlist ($linkslref, $indent);
    $string .= "$$rmref";

  return (\$string);
};






1;                            # Insure TRUE return if module is interpreted.