# -*- perl -*-
#
# DO NOT MOVE THE FIRST LINE
# It identifies the rest of the file as PERL for EMACS autoformatting
# put perl options at the end of that line, e.g., -p
#
#
# -------------------------------------------------------------------
# X-BONE
#
# http://www.isi.edu/xbone
# USC Information Sciences Institute (USC/ISI)
# Marina del Rey, California 90292, USA
# Copyright (c) 1998-2005
#
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute. The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
#
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
# $RCSfile: XB_API_OM.pm,v $
#
# $Revision: 1.14 $
# $Author: pingali $
# $Date: 2005/03/31 07:03:51 $
# $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Gregory Finn
##################################################
#
#
# Xbone API utilities used only by the OM
#
# Principal author: Gregory Finn
#
##################################################
package XB_API_OM;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw();
use strict;
#use Data::Dumper; # Used for debugging, comment out for release
use XB_Params;
use XB_XOL;
#use XB_Log;
######################################################################
#
# sub XB_check_create ( chref )
#
# The argument chref references the hash that contains the create
# message data structure. A series of checks is run on its contents.
# If the message fails the tests, FALSE (0) is returned. Otherwise,
# TRUE is returned.
######################################################################
sub XB_check_create ($)
{
my ($chref) = @_; my ($href, $key, $retval);
my (@create_keys) = ( 'command', 'xol_program', 'search_radius' );
##################################
# Perform keyword existence checks
# 'app' and 'app_argstring' are
# optional
##################################
foreach $key (@create_keys)
{
if (!exists ($chref->{$key}))
{ return ("Missing $key keyword in create\n"); };
};
##############################
# Perform keyword value checks
##############################
if ($chref->{command} !~ /^create_overlay$/)
{ return ("Command must be create_overlay\n"); }
else
{ shift (@create_keys); } # command value has been checked
shift (@create_keys); # program value not checked below
$retval = XB_XOL::XB_check_criterion_values ($chref, @create_keys);
if ($retval)
{ return ($retval); };
return (0);
}
######################################################################
#
# sub XB_check_list_overlays ( chref )
#
######################################################################
sub XB_check_list_overlays ($)
{
my ($chref) = @_;
my ($key, $retval);
my @list_overlays_keys = ('command', 'user_id', 'auth_type');
##################################
# Perform keyword existence checks
##################################
foreach $key (@list_overlays_keys)
{
if (!exists ($chref->{$key}))
{ return ("Missing $key keyword in list_overlays\n"); };
};
##############################
# Perform keyword value checks
##############################
if ($chref->{command} !~ /^list_overlays$/)
{ return ("Command must be list_overlays\n"); }
else
{ shift (@list_overlays_keys); } # command value has been checked
$retval = XB_XOL::XB_check_criterion_values ($chref, @list_overlays_keys);
if ($retval)
{ return ($retval); };
return (0);
}
######################################################################
#
# sub XB_check_overlay_status ( chref )
#
######################################################################
sub XB_check_overlay_status ($)
{
my ($chref) = @_;
my ($key, $retval);
my @overlay_status_keys = ('command', 'user_id', 'auth_type',
'search_radius', 'overlay_name');
##################################
# Perform keyword existence checks
##################################
foreach $key (@overlay_status_keys)
{
if (!exists ($chref->{$key}))
{ return ("Missing $key keyword in overlay_status\n"); };
};
##############################
# Perform keyword value checks
##############################
if ($chref->{command} !~ /^overlay_status$/)
{ return ("Command must be overlay_status\n"); }
else
{ shift (@overlay_status_keys); } # command has been checked
$retval = XB_XOL::XB_check_criterion_values ($chref, @overlay_status_keys);
if ($retval)
{ return ($retval); };
return (0);
}
######################################################################
#
# sub XB_check_discover_daemons ( chref )
#
######################################################################
sub XB_check_discover_daemons ($)
{
my ($chref) = @_;
my ($key, $retval);
my @discover_keys = ('command', 'user_id', 'auth_type',
'creator_name', 'creator_email');
##################################
# Perform keyword existence checks
##################################
foreach $key (@discover_keys)
{
if (!exists ($chref->{$key}))
{ return ("Missing $key keyword in discover_daemons\n"); };
};
##############################
# Perform keyword value checks
##############################
if ($chref->{command} !~ /^discover_daemons$/)
{ return ("Command must be discover_daemons\n"); }
else
{ shift (@discover_keys); } # command value has been checked
$retval = XB_XOL::XB_check_criterion_values ( $chref, @discover_keys );
if ($retval)
{ return ($retval); };
return (0);
}
######################################################################
#
# sub XB_check_destroy_overlay ( chref )
#
######################################################################
sub XB_check_destroy_overlay ($)
{
my ($chref) = @_;
my ($key, $retval);
my @destroy_overlay_keys = ('command', 'user_id', 'auth_type',
'overlay_name');
##################################
# Perform keyword existence checks
##################################
foreach $key (@destroy_overlay_keys)
{
if (!exists ($chref->{$key}))
{ return ("Missing $key keyword in destroy_overlay\n"); };
};
##############################
# Perform keyword value checks
##############################
if ($chref->{command} !~ /^destroy_overlay$/)
{ return ("Command must be destroy_overlay\n"); }
else
{ shift (@destroy_overlay_keys); } # command value has been checked
$retval = XB_XOL::XB_check_criterion_values ($chref, @destroy_overlay_keys);
if ($retval)
{ return ($retval); };
return (0);
}
######################################################################
#
# sub XB_check_destroyall_overlays ( chref )
#
######################################################################
sub XB_check_destroyall_overlays ($)
{
my ($chref) = @_;
my ($key, $retval);
my @destroyall_overlays_keys = ('command', 'user_id', 'auth_type');
##################################
# Perform keyword existence checks
##################################
foreach $key (@destroyall_overlays_keys)
{
if (!exists ($chref->{$key}))
{ return ("Missing $key keyword in destroyall_overlays\n"); };
};
##############################
# Perform keyword value checks
##############################
if ($chref->{command} !~ /^destroyall_overlays$/)
{ return ("Command must be destroyall_overlays\n"); }
else
{ shift (@destroyall_overlays_keys); } # command value has been checked
$retval = XB_XOL::XB_check_criterion_values ($chref,
@destroyall_overlays_keys);
if ($retval)
{ return ($retval); };
return (0);
}
###################################################################
#
# XB_net_check ( ovhref )
#
# On success returns a 0 result. Otherwise, it returns an error
# message that reflects the semantic error.
###################################################################
sub XB_net_check ($)
{
my ($ovhref) = @_;
my ($ntopohref, $nihref, $netname);
$ntopohref = $ovhref->{net_topology};
$nihref = $ovhref->{net_interfaces};
$netname = $ovhref->{net_name};
return (XB_net_references_check ($ntopohref, $nihref, $netname));
}
###################################################################
#
# XB_net_references_check ( cshref, nihref, nname )
#
# On success returns a 0 result. Otherwise, it returns an error
# message that reflects the semantic error.
###################################################################
sub XB_net_references_check ($$$)
{
my ($cshref, $nihref, $nname) = @_;
my ($hhref, $rhref, $lhref, $objects, $obj, $nllref, $links, $interfaces);
$objects = ' '; # Space is significant here
$objects .= "$nname "; # Net name is implicitly an object
$interfaces = ' '; # Space is significant here
$interfaces .= XB_net_gather_interfaces ($nname, $nihref);
#################################################
# The overlay and nodes are objects that are
# referenced by a name unique within the net.
#################################################
################
# Node objects
################
$rhref = $cshref->{nodes};
foreach $obj (keys %{$rhref})
{
if ($objects =~ / $obj /)
{
return ("In net $nname, node $obj defined as network.");
};
$interfaces .= XB_net_gather_interfaces
($obj, $rhref->{$obj}{interfaces});
$objects .= "$obj ";
};
##############
# Link objects
##############
$links = ' '; # Space is significant here
$lhref = $cshref->{links};
foreach $obj (keys %{$lhref})
{
if ($links =~ / $obj /)
{
return ("In net $nname, link $obj aready defined.");
};
$links .= "$obj ";
};
# print "\nOBJECTS: $objects\n";
# print "LINKS: $links\n";
# print "INTERFACES: $interfaces\n";
###############################
# Check that links mentioned in
# netlist are defined objects
###############################
$nllref = $cshref->{netlist};
foreach $lhref (@$nllref)
{
if (!XB_net_link_checks ($lhref, \$links, \$interfaces))
{
return ("Net $nname " . $XB_XOL::sem_err);
};
};
return (0);
}
###################################################################
#
# XB_net_gather_interfaces ( object, ihref )
#
# Gathers set of possible end_associations for the named object
# and returns them in string form. ihref is a reference to the
# interfaces proplist for object.
###################################################################
sub XB_net_gather_interfaces ($$)
{
my ($object, $ihref) = @_;
my ($ifkey, $endassocs);
$endassocs = '';
foreach $ifkey (keys %{$ihref})
{ $endassocs .= "$object:$ifkey "; };
return ($endassocs);
}
sub XB_net_link_checks ($$$)
{
my ($lhref, $lsref, $isref) = @_;
my ($endassoc);
##############################
# Check rule's link is defined
##############################
if ($$lsref !~ / $lhref->{link} /)
{
$XB_XOL::sem_err = "link reference $lhref->{link} not defined.";
return (0);
};
###############################################
# Check rule's local end-association is defined
###############################################
$endassoc = "$lhref->{lcl_object}:$lhref->{lcl_iface}";
if ($$isref !~ / $endassoc /)
{
$XB_XOL::sem_err =
"link $lhref->{link} local end_association $endassoc not defined.";
return (0);
};
############################################
# Ensure that if non-specific remote object
# is specified that remote interface is wild
############################################
$endassoc = "$lhref->{rem_object}:$lhref->{rem_iface}";
if ($lhref->{rem_object} =~ /\.[HRO]$/)
{
if ($lhref->{rem_iface} !~ /^\*\.I$/)
{
$XB_XOL::sem_err =
"link $lhref->{link} requires wildcard remote end_association for $endassoc.";
return (0);
};
};
#################################################
# Check rule's remote end-association is defined.
# Remove ".O", ".N" object class suffixes and
# ".I" interface class suffix for match.
#################################################
$endassoc = "$lhref->{rem_object}";
$endassoc =~ s/\.[NO]$//;
$endassoc .= ":$lhref->{rem_iface}";
$endassoc =~ s/\.I$//;
if ($$isref !~ / $endassoc /)
{
$XB_XOL::sem_err =
"link $lhref->{link} remote end_association $endassoc not defined.";
return (0);
};
return (1);
}
#######################################################################
#
# XB_build_node_msg ( class, vnode, dns_name, interfaces, ip_address, os,
# status, tunnelsref )
#
#######################################################################
sub XB_build_node_msg ($$$$$$$$)
{
my ( $class, $vnode, $dns_name, $interfaces, $ip_address, $os, $status,
$tunnelsref ) = @_; my ($string, $cs_ref);
$string .= '( node ';
$cs_ref = XB_XOL::XB_build_criterions ( 'class', $class,
'vnode', $vnode,
'dns_name', $dns_name,
'interfaces', $interfaces,
'ip_address', $ip_address,
'os', $os,
'status', $status
);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= $$tunnelsref;
$string .= ")\n";
return (\$string);
}
###############################################################################
#
# XB_build_dd_node_msg ( class, id, ip_address, os, release, dynamic_routing,
# ipsec_encr, ipsec_auth, overlays, max_overlays,
# tunnels, max_tunnels )
#
###############################################################################
sub XB_build_dd_node_msg ($$$$$$$$$$$$$)
{
my ($class, $dns_name, $ip_address, $os, $release, $dynamic_routing,
$ipsec_encr, $ipsec_auth, $overlays, $max_overlays, $tunnels,
$max_tunnels, $dummynet) = @_;
my ($string, $cs_ref);
$string .= '( node ';
$cs_ref = XB_XOL::XB_build_criterions (
'class', $class,
'dns_name', $dns_name,
'ip_address', $ip_address,
'os', $os,
'release', $release,
'dynamic_routing', $dynamic_routing,
'authentication', $ipsec_auth,
'encryption', $ipsec_encr,
'overlays', $overlays,
'max_overlays', $max_overlays,
'tunnel_count', $tunnels,
'max_tunnels', $max_tunnels,
'dummynet', $dummynet
);
if(!defined ($cs_ref)) {
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= ")\n";
return (\$string);
}
#######################################################################
#
# XB_build_crnode_msg ( class, dns_name, vnode, interfaces, ip_address, os, status )
#
# Variant to create a node used for create_overlay_reply messages.
# The tunnel and id criterions are omitted and a dns-name criterion is
# added.
#######################################################################
sub XB_build_crnode_msg ($$$$$$$)
{
my ( $class, $dns_name, $vnode, $interfaces, $ip_address, $os, $status ) = @_;
my ($string, $cs_ref);
$string .= '( node ';
$cs_ref = XB_XOL::XB_build_criterions ( 'class', $class,
'dns_name', $dns_name,
'vnode', $vnode,
'interfaces', $interfaces,
'ip_address', $ip_address,
'os', $os,
'status', $status
);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= ")\n"; # End ( node
return (\$string);
}
#######################################################################
#
# XB_build_tunnel_msg ( lcl_ip_addr, rem_ip_addr, status )
#
#######################################################################
sub XB_build_tunnel_msg ($$$)
{
my ( $lcl_ip_addr, $rem_ip_addr, $status ) = @_;
my ($string, $cs_ref);
$string .= '( tunnel ';
$cs_ref = XB_XOL::XB_build_criterions ( 'local_ip_address', $lcl_ip_addr,
'remote_ip_address', $rem_ip_addr,
'status', $status
);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= ")\n"; # End ( tunnel
return (\$string);
}
#######################################################################
#
# XB_build_create_overlay_reply_msg ( auth_type, creator_name, creator_email,
# overlay_name, user_id, topology, nodesref )
#
#######################################################################
sub XB_build_create_overlay_reply_msg ($$$$$$$)
{
my ( $auth_type, $creator_name, $creator_email,
$overlay_name, $user_id, $topology, $nodesref ) = @_;
my ($string, $cs_ref);
$string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
$string .= "\t( create_overlay_reply ";
$cs_ref = XB_XOL::XB_build_criterions ( 'auth_type', $auth_type,
'creator_name', $creator_name,
'creator_email', $creator_email,
'overlay_name', $overlay_name,
'user_id', $user_id, 'topology', $topology
);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= "$$nodesref\n";
$string .= ")\n"; # End ( create_overlay_reply
$string .= ")\n"; # End ( xbone
$string .= "XboneEOC\n"; # End record
return (\$string);
}
#######################################################################
#
# XB_build_destroy_overlay_reply_msg ( overlay )
#
# The overlay argument is the string name of an overlay.
#
#######################################################################
sub XB_build_destroy_overlay_reply_msg ($)
{
my ($overlay) = @_; my ($string, $cs_ref);
$string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
$string .= "\t( destroy_overlay_reply ";
$cs_ref = XB_XOL::XB_build_criterions ('overlay_name', $overlay);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= ")\n"; # End ( destroy_overlay_reply
$string .= ")\n"; # End ( xbone
$string .= "XboneEOC\n"; # End record
return (\$string);
}
#######################################################################
#
# XB_build_overlay_status_reply_msg ( auth_type, creator_name, creator_email,
# ipsec_auth, ipsec_encr, topology,
# overlay_name, user_id, nodesref )
#
#######################################################################
sub XB_build_overlay_status_reply_msg ($$$$$$$$$$$)
{
my ($auth_type, $creator_name, $creator_email, $ipsec_auth,
$ipsec_encr, $topology, $overlay_name, $user_id,
$dynamic_routing, $dummynet, $nodesref ) = @_;
my ($string, $cs_ref);
$string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
$string .= "\t( overlay_status_reply ";
$cs_ref = XB_XOL::XB_build_criterions ( 'auth_type', $auth_type,
'creator_name', $creator_name,
'creator_email', $creator_email,
'topology', $topology,
'authentication', $ipsec_auth,
'encryption', $ipsec_encr,
'dynamic_routing', $dynamic_routing,
'dummynet', $dummynet,
'overlay_name', $overlay_name,
'user_id', $user_id
);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= "$$nodesref\n";
$string .= ")\n"; # End ( overlay_status_reply
$string .= ")\n"; # End ( xbone
$string .= "XboneEOC\n"; # End record
return (\$string);
}
#######################################################################
#
# XB_build_discover_daemons_reply_msg ( auth_type, creator_name, creator_email,
# user_id, nodesref )
#
#######################################################################
sub XB_build_discover_daemons_reply_msg ($$$$$)
{
my ($auth_type, $creator_name, $creator_email, $user_id, $nodesref ) = @_;
my ($string, $cs_ref);
$string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
$string .= "\t( discover_daemons_reply ";
$cs_ref = XB_XOL::XB_build_criterions ( 'auth_type', $auth_type,
'creator_name', $creator_name,
'creator_email', $creator_email,
'user_id', $user_id
);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= $$nodesref;
$string .= ")\n"; # End ( discover_daemons_reply
$string .= ")\n"; # End ( xbone
$string .= "XboneEOC\n"; # End record
return (\$string);
}
#######################################################################
#
# XB_build_destroyall_overlays_reply_msg ( message )
#
#######################################################################
sub XB_build_destroyall_overlays_reply_msg ($)
{
my ($message) = @_; my ($string, $cs_ref);
$string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
$string .= "\t( destroyall_overlays_reply ";
$cs_ref = XB_XOL::XB_build_criterions ('message', $message);
if (!defined ($cs_ref))
{
#LOG FATAL ERROR MESSAGE
};
$string .= $$cs_ref;
$string .= ")\n"; # End ( destroyall_overlays_reply
$string .= ")\n"; # End ( xbone
$string .= "XboneEOC\n"; # End record
return (\$string);
}
#######################################################################
#
# XB_build_list_overlays_reply_msg ( names_sref )
#
# The names_sref is a reference to a string that contains overlay names.
# Overlay names are separated by whitespace.
#
#######################################################################
sub XB_build_list_overlays_reply_msg ($)
{
my ($names_sref) = @_; my ($string, $cs_ref);
$string = "( xbone $XB_Params::XBONE_PROTOCOL $XB_Params::XBONE_RELEASE\n";
$string .= "\t( list_overlays_reply ";
$string .= $$names_sref;
$string .= ")\n"; # End ( list_overlays_reply
$string .= ")\n"; # End ( xbone
$string .= "XboneEOC\n"; # End record
return (\$string);
}
1; # Insure TRUE return if module is interpreted.
syntax highlighted by Code2HTML, v. 0.9.1