# -*- 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.