### Local Variables: ***
### mode:perl ***
### comment-column:0 ***
### comment-start: "### " ***
### comment-end: "***" ***
### End: ***
#
# ****************DO NOT MOVE OR CHANGE LINES ABOVE THIS*********************
#
# The first set of lines runs perl from any shell. The second set of lines
# identifies the rest of the file as PERL for EMACS autoformatting.
# See end of copyright for more information.
#
#
# -------------------------------------------------------------------
# X-BONE
#
# http://www.isi.edu/xbone
# USC Information Sciences Institute (USC/ISI)
# Marina del Rey, California 90292, USA
# Copyright (c) 1998-2005
#
# -------------------------------------------------------------------
#
# Copyright (c) 1998-2005 by the University of Southern California.
# All rights reserved.
#
# Permission to use, copy, modify, and distribute this software and
# its documentation in source and binary forms for non-commercial
# purposes and without fee is hereby granted, provided that the above
# copyright notice appear in all copies and that both the copyright
# notice and this permission notice appear in supporting
# documentation, and that any documentation, advertising materials,
# and other materials related to such distribution and use acknowledge
# that the software was developed by the University of Southern
# California, Information Sciences Institute. The name of the
# University may not be used to endorse or promote products derived
# from this software without specific prior written permission.
#
# THE UNIVERSITY OF SOUTHERN CALIFORNIA MAKES NO REPRESENTATIONS ABOUT
# THE SUITABILITY OF THIS SOFTWARE FOR ANY PURPOSE. THIS SOFTWARE IS
# PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES,
# INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
#
# Other copyrights might apply to parts of this software and are so
# noted when applicable.
#
# -------------------------------------------------------------------
#
# Effort partly sponsored by the Defense Advanced Research Projects
# Agency (DARPA) and Air Force Research Laboratory, Air Force Materiel
# Command, USAF, under agreement numbers F30602-98-1-0200 (X-Bone) and
# F30602-01-2-0529 (DynaBone). The views and conclusions contained
# herein are those of the authors and should not be interpreted as
# necessarily representing the official policies or endorsements,
# either expressed or implied, of the Defense Advanced Research
# Projects Agency (DARPA), the Air Force Research Laboratory, or the
# U.S. Government.
#
# This work was partly supported by the NSF STI-XTEND (ANI-0230789)
# and NETFS (ANI-0129689) projects. Any opinions, findings, and
# conclusions or recommendations expressed in this material are those
# of the authors and do not necessarily reflect the views of the
# National Science Foundation.
#
# -------------------------------------------------------------------
# $RCSfile: XB_VN_funcs.pm,v $
#
# $Revision: 1.47 $
# $Author: pingali $
# $Date: 2005/03/31 07:04:00 $
# $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Yu-Shun Wang
# Descirption: Functions for processing overlays (virtual networks)
package XB_VN_funcs;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw();
@EXPORT_OK = qw(config_node_cmds
status_ping);
use strict;
use sigtrap;
use Data::Dumper;
use Net::Ping;
use XB_Dummynet;
use XB_Route;
use XB_Tunnel;
use XB_VN_Graph;
use XB_Zebra;
my $modname = "XB_VN_funcs::";
my $spi_counter = 256;
###############################################################################
# UTILITY FUNCTIONS
###############################################################################
# Description:
# Generate IPsec parameters based on given algorithms
# Arguments:
# $auth IPsec authentication algorithm or undef
# $encr IPsec encryption algorithm or under
# Returns:
# \$cmd (ref) IPsec command string
# Exceptions:
# -
sub IPsec_params ($$)
{
my $procname = "IPsec_params";
XB_Log::log "info", "-> $modname$procname: @_\n";
my ($auth, $encr) = @_;
my $fwd_auth = "(auth undef 0x0)";
my $fwd_encr = "(encr undef 0x0)";
my $rev_auth = "(auth undef 0x0)";
my $rev_encr = "(encr undef 0x0)";
my $bl = " ";
#TODO need make $spi unique across multiple OMs (use ovlnet addr?)
my $spi = sprintf "0x%08x", ++$spi_counter;
if ($auth ne "undef" and $auth ne 'none'){
$fwd_auth = "(auth $auth ". XB_IPsec::key($auth). ")";
$rev_auth = "(auth $auth ". XB_IPsec::key($auth). ")";
}
if ($encr ne "undef" and $encr ne 'none'){
$fwd_encr = "(encr $encr ". XB_IPsec::key($encr). ")";
$rev_encr = "(encr $encr ". XB_IPsec::key($encr). ")";
}
XB_Log::log "info", "<- $modname$procname:\n";
my $fwd_cmd =
"\n$bl(ipsec $spi\n".
"$bl (forward $fwd_auth\n$bl $fwd_encr)\n".
"$bl (reverse $rev_auth\n$bl $rev_encr) )";
my $rev_cmd =
"\n$bl(ipsec $spi\n".
"$bl (forward $rev_auth\n$bl $rev_encr)\n".
"$bl (reverse $fwd_auth\n$bl $fwd_encr) )";
return (\$fwd_cmd, \$rev_cmd);
}
###############################################################################
# EXPORTED API
###############################################################################
#------------------------------------------------------------------------------
# API functions
# -----------------------------------------------------------------------------
# Description:
# [VN] Make node config commands for a given overlay
# - get the assigned address blocks for overlay net & link
# - assign addresses to all interfaces
# - if static routes, compute static routes
# - other overlay features: qos, app scripts, etc.
# - construct node commands for each node
# Arguments:
# $app_obj (ref) application object hash
# Returns:
# \%node_cmd_hash (ref) hash of nodes & their node commands
# Exceptions:
# "XB_VN_funcs::make_node_config" on failure, caller should delete the
# overlay and remove all data objects
#
sub make_node_config($){
my ($app_obj) = @_;
my $procname = "make_node_config";
my %node_cmd_hash = ();
XB_Log::log "info", "-> $modname$procname". Dumper($app_obj);
eval{
#=> prepare the overlay object hash
my $ovl = $app_obj->{application}{network};
my $name = $app_obj->{application}{name};
my $pro = $ovl->{properties};
my $ip_net = $pro->{addr_blk_net};
my $ip_link = $pro->{addr_blk_link};
my $routing = $pro->{routing};
my $ip_all = $pro->{addr_blk_all};
my $ipsec = $pro->{IPsec};
my $ipsec_e = $pro->{IPsec_encryption};
my $ipsec_a = $pro->{IPsec_authentication};
my $qos = $pro->{qos};
my $dummynet_delay = $pro->{dummynet_delay};
my $dummynet_bandwidth = $pro->{dummynet_bandwidth};
my $dummynet_bandwidth_unit = $pro->{dummynet_bandwidth_unit};
my $dummynet_queue = $pro->{dummynet_queue};
my $dummynet_queue_unit = $pro->{dummynet_queue_unit};
my $dummynet_loss_rate = $pro->{dummynet_loss_rate};
my $ipproto = $pro->{address_type};
#=> assign addresses to all interfaces
unless($XB_Params::new_alloc){
XB_VN_IPalloc::assign($ip_net, $ovl, "netaddr");
XB_VN_IPalloc::assign($ip_link, $ovl, "linkaddr");
}else{
XB_VN_IPalloc::new_assign($ip_net, $ovl, "netaddr");
XB_VN_IPalloc::new_assign($ip_link, $ovl, "linkaddr");
}
#=> routing
if($routing =~ /dynamic/i){
# dynamic routing
XB_Log::log "info", " [$procname] dynamic routing";
}elsif($ovl->{properties}{router} > 1){
# static routing: compute static routes
# - no need to compute routes unless it has more than 1 routers
XB_VN_Graph::compute_routes($ovl);
}
#=> other overlay features: qos, app scripts, etc.
my $qosmsg = "";
if (defined $qos and $qos !~ /no/i) {
my $gap = " ";
$qosmsg .= "\n$gap(qos \n";
if (defined $dummynet_delay) {
$qosmsg .= "$gap (delay $dummynet_delay)\n"
}
if (defined $dummynet_bandwidth) {
$qosmsg .= "$gap (bandwidth $dummynet_bandwidth $dummynet_bandwidth_unit)\n"
}
if (defined $dummynet_queue) {
$qosmsg .= "$gap (queue $dummynet_queue $dummynet_queue_unit)\n"
}
if (defined $dummynet_loss_rate) {
$qosmsg .= "$gap (loss_rate $dummynet_loss_rate)\n"
}
$qosmsg .= "$gap)\n";
};
#=> construct the node commands from the overlay object hash
my $links = $ovl->{links};
my $nodes = $ovl->{nodes};
my $ifs = $ovl->{interfaces};
$pro->{all_virtual_ip} = [];
$pro->{all_virtual_hostname} = [];
$pro->{all_base_ip} = [];
$pro->{all_base_hostname} = [];
for my $n (keys %{$nodes}){
$nodes->{$n}{node_cmds}{links} = [];
$nodes->{$n}{node_cmds}{routes} = [];
$nodes->{$n}{properties}{virtual_ip} = [];
}
#=====================================================================
#-> link commands (tunnel + IPsec + QoS)
#=====================================================================
# ($linkname
# (interface $local_if_name)
# (netaddr 10.2.0.1 10.2.0.2 255.255.255.252)
# (linkaddr 10.1.0.1 10.1.0.2 255.255.255.252
# (ipsec 0x00000102
# (forward
# (auth undef 0x0)
# (encr 3des 0xca1d6a852d094...9d994c))
# (reverse
# (auth undef 0x0)
# (encr 3des 0x669ee0bc21d06...1c94e9))
# )
# (qos
# (delay 10)
# (bandwidth 10 Kbits/s)
# (queue 10 slots)
# (loss_rate 0.4)
# )
# )
# (physical 128.9.160.1 128.9.160.2)
# )
for my $l (keys %{$links}){
my ($rnode, $rif, $lnode, $lif, $lname, $ltype, $rnet, $lnet);
my ($rlink, $llink, $rphy, $lphy, $mask, $r_to_l, $l_to_r);
my ($ipsec_fwd, $ipsec_rev);
# Tunnel
$rnode = $links->{$l}{right_node};
$rif = $links->{$l}{right_if};
$lnode = $links->{$l}{left_node};
$lif = $links->{$l}{left_if};
$ltype = $links->{$l}{type};
$rnet = $nodes->{$rnode}{interfaces}{$rif}{netaddr};
$rlink = $nodes->{$rnode}{interfaces}{$rif}{linkaddr};
$rphy = (defined $nodes->{$rnode}{interfaces}{$rif}{phyaddr})?
$nodes->{$rnode}{interfaces}{$rif}{phyaddr} :
$nodes->{$rnode}{properties}{app_addr};
$lnet = $nodes->{$lnode}{interfaces}{$lif}{netaddr};
$llink = $nodes->{$lnode}{interfaces}{$lif}{linkaddr};
$lphy = (defined $nodes->{$lnode}{interfaces}{$lif}{phyaddr})?
$nodes->{$lnode}{interfaces}{$lif}{phyaddr} :
$nodes->{$lnode}{properties}{app_addr};
if($rnet =~ /:/){
$mask = "ffff:ffff:ffff:ffff:ffff:ffff:ffff:fffc";
}else{
$mask = "255.255.255.252";
}
# IPsec
if($ipsec =~ /yes/i){
($ipsec_fwd, $ipsec_rev) = IPsec_params($ipsec_a, $ipsec_e);
($ipsec_fwd, $ipsec_rev) = ($$ipsec_fwd, $$ipsec_rev);
}else{
$ipsec_fwd = "";
$ipsec_rev = "";
}
$r_to_l =
"($l (interface $rif)\n".
" (netaddr $rnet $lnet $mask)\n".
" (linkaddr $rlink $llink $mask $ipsec_fwd $qosmsg)\n".
" (physical $rphy $lphy))";
$l_to_r =
"($l (interface $lif)\n".
" (netaddr $lnet $rnet $mask)\n".
" (linkaddr $llink $rlink $mask $ipsec_rev $qosmsg)\n".
" (physical $lphy $rphy))";
push @{ $nodes->{$rnode}{node_cmds}{links} }, $r_to_l;
push @{ $nodes->{$lnode}{node_cmds}{links} }, $l_to_r;
if($ltype eq "router"){
if(defined $nodes->{$rnode}{routes}{$lnode}{destinations}){
$nodes->{$rnode}{routes}{$lnode}{address} = $lnet;
}
if(defined $nodes->{$lnode}{routes}{$rnode}{destinations}){
$nodes->{$lnode}{routes}{$rnode}{address} = $rnet;
}
}else{
if($nodes->{$rnode}{properties}{type} eq "host"){
$nodes->{$rnode}{properties}{default_router_ip} = $lnet;
}else{
$nodes->{$lnode}{properties}{default_router_ip} = $rnet;
}
}
}
#=====================================================================
#-> route commands:
#=====================================================================
# o static: o dynamic:
# (host 10.1.1.1 10.1.1.2) (addr_range 10.1.2.0/20)
# (net 10.2.2/20 10.2.2.1) (addr_range 10.2.3.0/24)
# o piggyback:
# utilize this loop to gather some overlay info
for my $n (keys %{$nodes}){
my $nd = $nodes->{$n};
#-> route processing
if($routing =~ /static/i){
# static routes
if($nd->{properties}{type} eq "host"){
my $gw = $nd->{properties}{default_router_ip};
for my $dt (@{$ip_all}){
push @{ $nd->{node_cmds}{routes} }, "(net $dt $gw)";
}
}else{
for my $gw (keys %{$nd->{routes}}){
my $gwaddr = $nd->{routes}{$gw}{address};
for my $d (@{ $nd->{routes}{$gw}{destinations} }){
for my $ld (@{ $nodes->{$d}{properties}{local_dest} }){
my $t = ($ld =~ /\//)? "net":"host";
# in case of ipv6 the prefix is 128. route command
# fails when the destination is gateway itself. so
# skip that one case for ipv6.
if ($gwaddr ne $ld){
push @{ $nd->{node_cmds}{routes} }, "($t $ld $gwaddr)";
}
}
}
}
}
}else{
#-> dynamic routing: needs only the overlay network address prefixes
for my $dt (@{$ip_all}){
push @{ $nd->{node_cmds}{routes} }, "(addr_range $dt)";
}
}
#-> gather overlay parameters
my $vip;
for my $iface (keys %{$nd->{interfaces}}){
if(not defined $nd->{interfaces}{$iface}){ next; }
$vip = $nd->{interfaces}{$iface}{netaddr};
push @{$nd->{properties}{virtual_ip}}, $vip;
# TODO do we need all IPs of a node? or just one?
#push @{$pro->{all_virtual_ip}}, $vip;
}
push @{$pro->{all_virtual_ip}}, $vip;
push @{$pro->{all_base_ip}}, $nd->{properties}{app_addr};
push @{$pro->{all_base_hostname}}, $nd->{properties}{hostname};
}
#add virtual hostname list
my $overlay = $name;
$overlay =~ s/\.$XB_Params::XBONE_NET//g; # remove the suffix
for my $t (keys %{$app_obj->{application}{resources}}){
for my $n (keys %{$app_obj->{application}{resources}{$t}}){
my $node = $app_obj->{application}{resources}{$t}{$n}{vnode};
my $hostname = "$node.$overlay.$XB_Params::node_opts{forward_zone}";
push @{$pro->{all_virtual_hostname}},$hostname;
}
}
#=====================================================================
#-> overlay parameters:
#=====================================================================
my $om_ip = ($pro->{address_type} eq 'ipv4')?
$XB_Params::node_opts{ctl_addr} : $XB_Params::node_opts{ctl_addr6};
my $om_api = $XB_Params::node_opts{xbone_api_port};
my $all_vip = " (all_virtual_ip\n ".
(join "\n ", @{$pro->{all_virtual_ip}}). ")\n";
my $all_vhn = ($pro->{dns} eq 'yes')?
" (all_virtual_hostname\n ".
(join "\n ", @{$pro->{all_virtual_hostname}}). ")\n": '';
my $all_bip = " (all_base_ip\n ".
(join "\n ", @{$pro->{all_base_ip}}). ")\n";
my $all_bhn = " (all_base_hostname\n ".
(join "\n ", @{$pro->{all_base_hostname}}). ")\n";
my $ovl_par = $all_vip. $all_vhn. $all_bip. $all_bhn.
" (domain $name)\n".
" (prefix ". (join ' ', @{$ip_all}). ")\n".
" (om $om_ip)\n".
" (api $om_api)\n".
" )\n";
for my $n (keys %{$nodes}){
my $npro = $nodes->{$n}{properties};
my $vip = " (virtual_ip\n ".
(join "\n ", @{$npro->{virtual_ip}}). ")\n";
my $vhn = '';
my $n_par = " (ovl-parameters\n". $vip. $vhn.
" (base_ip ". $npro->{app_addr}. ")\n".
" (base_hostname ". $npro->{hostname}. ")\n".
$ovl_par;
$nodes->{$n}{node_cmds}{ovl_params} = $n_par;
}
#=====================================================================
#-> application scripts
#=====================================================================
my $app_deploy_sec = '';
if(defined $ovl->{app_deploy}){
for my $appname (keys %{$ovl->{app_deploy}}){
my $script = $ovl->{app_deploy}{$appname}{script};
my $action = $ovl->{app_deploy}{$appname}{action};
$app_deploy_sec .=
" (app-deploy\n".
" (name $appname)\n".
" (action $action))\n";
}
}
#-> gather all the link & route commands to form complete sections of
# node commands
for my $n (keys %{$nodes}){
my $link_cmd = " (link\n ".
(join "\n ", @{$nodes->{$n}{node_cmds}{links}}). ")\n";
my $route_cmd = " (route $routing\n ".
(join "\n ", @{$nodes->{$n}{node_cmds}{routes}}). ")\n";
$node_cmd_hash{$n} =
" (nodecommand $n\n".
" (addr_type $ipproto)\n".
$link_cmd.
$route_cmd.
$app_deploy_sec.
$nodes->{$n}{node_cmds}{ovl_params}.
" )\n";
}
XB_Log::log "debug6", " Node Command Hash: ". Dumper(\%node_cmd_hash);
};
XB_Log::log "info", "<- $modname$procname";
return \%node_cmd_hash unless $@;
unless($@ =~ /(assign|compute_route)/){
XB_Log::log "warning", " ! $procname caught unknown exception: $@";
}
die "$modname$procname";
}
# Description:
# [VN] Process status replies from overlay nodes & update the overlay hash
# Arguments:
# $app_obj (ref) overlay hash
# $replies (ref) hash of parsed CTL status-reply objects
# $missing (ref) array of nodes that did not reply
# Returns:
# -
# Exceptions:
# "XB_VN_funcs::process_status" on failure, nothing to cleanup by caller
#
sub process_status($$$){
my ($app_obj, $replies, $missing) = @_;
my $procname = "process_status";
XB_Log::log "info", "-> $modname$procname $app_obj, $replies, $missing";
eval{
my $type = "overlay";
my $name = $app_obj->{application}{name};
my $net = $app_obj->{application}{network};
my $nodes = $net->{nodes};
my $links = $net->{links};
my (%phynode, $k, $v);
for my $t (keys %{$app_obj->{application}{resources}}){
while(($k, $v) = each %{$app_obj->{application}{resources}{$t}}){
$phynode{$k} = $v->{vnode}; #TODO REVISITATION BUG! >1 vnode!#
}
}
# for those who replied
for my $n (keys %{$replies}){
my $cmd = $replies->{$n};
if(! exists $phynode{$n}){
XB_Log::log "err", " [$procname] $n does not belong to ".
"$type $name";
next;
}
if($cmd->{command}{command} eq 'error'){
$nodes->{$phynode{$n}}{properties}{status} = "error";
$nodes->{$phynode{$n}}{properties}{error_msg} =
$cmd->{command}{message};
next;
}
$nodes->{$phynode{$n}}{properties}{status} = "up";
while(($k, $v) = each %{$cmd->{command}{vnodes}}){
unless($k eq $phynode{$n}){ #TODO REVISITATION BUG! >1 vnode! #
XB_Log::log "err", " [$procname] virtual node $k does not exist".
" in $type $name";
next;
}
my ($l, $h);
while(($l, $h) = each %{$v}){
$links->{$l}{status_net} = $h->{netaddr}{status};
$links->{$l}{status_link} = $h->{linkaddr}{status};
$links->{$l}{status_phy} = $h->{physical}{status};
}
}
}
# for those who did not
for my $m (@{$missing}){
$nodes->{$phynode{$m}}{properties}{status} = "down";
$nodes->{$phynode{$m}}{properties}{error_msg} =
"$m did not reply, could either be down or no XBone daemon running.";
}
};
XB_Log::log "info", "<- $modname$procname";
return 1 unless $@;
XB_Log::log "warning", " ! $procname caught unkown exception: $@";
die "$modname$procname";
}
#=========================================================================
# Control functions
#=========================================================================
# Description:
# [VN] Execute node commands (links, routes, ipsec) for a given overlay
# Arguments:
# $ctl_cmd (ref) control command hash
# $restore flag for doing crash recovery
# Returns:
# 1 on success
# 0 on failure
# Exceptions:
# -
# Notes:
# - Node command (ipsec, tunnel, route, qos, app scritp) failure will
# throw an exception inside eval, but will only cause the function
# to return 0 instead of dying inside the caller.
# - Need to add commit bits to all completed commands for failure clean
# up so it would only undo the completed commands.
#
sub exec_node_config($$){
my ($ctl_cmd, $restore) = @_;
my $procname = "exec_node_config";
XB_Log::log "info", "-> $modname$procname $ctl_cmd, $restore";
eval{
my $type = $ctl_cmd->{command}{app_type};
my $name = $ctl_cmd->{command}{app_name};
my $ncmds = $ctl_cmd->{command}{node_cmds};
XB_Log::log "debug1", "CTL cmd: " . Dumper($ctl_cmd->{command}{node_cmds});
#=> switch on node type: plain, control recursive, real recursive
#if($XB_Param{daemon_type} eq "meta"){
# if($ctl_cmd->{command}{recursion} eq "control"){
# # translate node commands at meta layer into sub-overlay
# }elsif($ctl_cmd->{command}{recursion} eq "true"){
# # translate node commands at meta layer into sub-overlay
# }
#}else{
# # non-recursive node
for my $vnode (keys %{ $ncmds }){
$ncmds->{$vnode}{ovl_params}{virtual_interface} = [];
my $vifs = $ncmds->{$vnode}{ovl_params}{virtual_interface};
my $routing = $ncmds->{$vnode}{routes}{style};
my @tun_net_interface = ();
# links
for my $link (keys %{$ncmds->{$vnode}{links}}){
my $ln = $ncmds->{$vnode}{links}{$link};
# tunnel link
XB_Log::log "debug2", " [$procname] tunnel up: ".
"$ln->{linkaddr}{local}, $ln->{linkaddr}{remote},\n ".
"$ln->{linkaddr}{netmask}, $ln->{physical}{local}, ".
"$ln->{physical}{remote}, link, $vnode, $routing";
my %hash = ( virtlocaladdr => $ln->{linkaddr}{local},
virtremoteaddr => $ln->{linkaddr}{remote},
netmask => $ln->{linkaddr}{netmask},
physlocaladdr => $ln->{physical}{local},
physremoteaddr => $ln->{physical}{remote},
layer => "link",
oid => $vnode,
routing_method => $routing
);
$ln->{link_up} = XB_Tunnel::up (\%hash);
XB_Log::log "debug2", " [$procname] link tunnel handle:\n ".
"$ln->{link_up}";
# tunnel net
XB_Log::log "debug2", " [$procname] tunnel up: ".
"$ln->{netaddr}{local}, $ln->{netaddr}{remote},\n ".
"$ln->{netaddr}{netmask}, $ln->{linkaddr}{local}, ".
"$ln->{linkaddr}{remote}, network, $vnode, $routing";
%hash = ( virtlocaladdr => $ln->{netaddr}{local},
virtremoteaddr => $ln->{netaddr}{remote},
netmask => $ln->{netaddr}{netmask},
physlocaladdr => $ln->{linkaddr}{local},
physremoteaddr => $ln->{linkaddr}{remote},
layer => "network",
oid => $vnode,
routing_method => $routing
);
$ln->{net_up} = XB_Tunnel::up (\%hash);
XB_Log::log "debug2", " [$procname] network tunnel handle:\n ".
"$ln->{net_up}";
if ($ln->{net_up} =~ /^(\w+\d+)|/){
my $interface = $1;
push @tun_net_interface, $interface;
push @{$vifs}, $interface;
}
# ipsec
if(defined $ln->{linkaddr}{ipsec}){
my $spi = $ln->{linkaddr}{ipsec}{spi};
my $fwd = $ln->{linkaddr}{ipsec}{forward};
my $rev = $ln->{linkaddr}{ipsec}{reverse};
# check IPsec is available on this host
if (not XB_IPsec::is_present) {
XB_Log::log "err", "IPsec is not available on this host!"
and die "IPsec";
}
# IPsec::add arguments: (spi & keys => "0x.." hex strings)
# fwd: src, dst, "out", spi, fa, fa_key, fe, fe_key
# rev: dst, src, "in", spi, ba, ba_key, be, be_key
# forward
XB_IPsec::add($ln->{linkaddr}{local}, $ln->{linkaddr}{remote},
"out", $spi,
$fwd->{auth}{alg}, $fwd->{auth}{key},
$fwd->{encr}{alg}, $fwd->{encr}{key});
# reverse
XB_IPsec::add($ln->{linkaddr}{remote}, $ln->{linkaddr}{local},
"in", $spi,
$rev->{auth}{alg}, $rev->{auth}{key},
$rev->{encr}{alg}, $rev->{encr}{key});
$ln->{link_ipsec_up} = 1;
}
# qos
if (defined $ln->{linkaddr}{qos}){
my %dummynet_args = ();
my $qos = $ln->{linkaddr}{qos};
$dummynet_args{delay} = $qos->{delay}{value};
$dummynet_args{loss_rate} = $qos->{loss_rate}{value};
$dummynet_args{bandwidth} = $qos->{bandwidth}{value};
$dummynet_args{bandwidth_unit} = $qos->{bandwidth}{unit};
$dummynet_args{queue} = $qos->{queue}{value};
$dummynet_args{queue_unit} = $qos->{queue}{unit};
if (defined $dummynet_args{queue_unit} && $dummynet_args
{queue_unit} =~ /slots/){
$dummynet_args{queue_unit} = "";
}
$ln->{link_dummynet_up} =
XB_Dummynet::up($ln->{linkaddr}{local},
$ln->{linkaddr}{remote}, \%dummynet_args);
};
# [Batch] push commands into ipsec, tun_link, tun_net
} #links
if($ncmds->{$vnode}{routes}{style} eq "static"){
# static routing
for my $rt (@{$ncmds->{$vnode}{routes}{routes}}){
my %hash = ( ovlname => $vnode,
routing_method => $routing,
dstarg => "-$rt->{type}",
destination => $rt->{dst},
gateway => $rt->{gw}
);
XB_Route::add_route \%hash;
$rt->{up} = 1;
# [Batch] push commands into routes
}
}else{
# dynamic routing
XB_Log::log "debug1", "dynamic routing start";
# check the number of network prefix
XB_Log::log "debug1", "ncmds".Dumper($ncmds);
my $prefix_array = $ncmds->{$vnode}{routes}{prefixes};
unless(@{$prefix_array} == 1){
XB_Log::log "err",
" [$procname] dynamic routing in xbone can only support\n".
" one network prefix per overlay"
and die "prefix";
}
# check whether ripd and zebra configure files are installed
my $zebradir = $XB_Params::node_opts{zebra_dir};
my $zebraconf= $zebradir."/zebra.conf";
my $ripdconf = "";
if ($ncmds->{$vnode}{ipproto} eq "ipv4") {
$ripdconf = $zebradir."/ripd.conf";
}elsif($ncmds->{$vnode}{ipproto} eq "ipv6") {
$ripdconf = $zebradir."/ripngd.conf";
}else {
XB_Log::log "err", "unknown address type!" and die "ipproto";
}
XB_Log::log "debug1", "zebraconf= $zebraconf,ripdconf=$ripdconf";
(-f $zebraconf) and (-f $ripdconf) or
XB_Log::log "alert","Please copy sample configure files to zebra \
home directory:".$XB_Params::node_opts{zebra_dir}
and die "configure";
my $conf = XB_Zebra::get_config($ncmds->{$vnode}{ipproto});
my %hash = ( ovlname => $ctl_cmd->{command}{app_name},
prefix => $ncmds->{$vnode}{routes}{prefixes}->[0],
net_if => \@tun_net_interface,
conf_file => $conf,
addr_type => $ncmds->{$vnode}{ipproto}
);
XB_Log::log "debug1", "Zebra Interface Hash:". Dumper (\%hash);
# check whether the interface is already configured
my $interfacenum = $#{$hash{net_if}} + 1;
my $configured = 0;
for (my $j=0; $j<$interfacenum; $j++) {
$configured = XB_Zebra::check_interface ($hash{conf_file},
$hash{net_if}->[$j]);
if ($configured) {
XB_Log::log "err", "the interface: $hash{net_inf}->[$j] \
has already been configured in $hash{conf_file}"
and die "interface";
}
}
XB_Zebra::add_interface (\%hash);
# restart zebra
XB_Zebra::zebra_control("restart");
}
#=================================================================
#-> application deployment
#=================================================================
if(defined $ncmds->{$vnode}{app_deploy}){
#-> construct command line options
# o list of command line parameters:
# -t target
# -i virtual IPs
# -h virtual hostname
# -I base IP
# -H base hostname
# -f interfaces
# -a all virtual IPs
# -n all virtual hostnames
# -A all base IPs
# -N all base hostnames
# -d overlay domain suffix
# -p overlay virtual prefixes
# -o overlay manager IP address & API port
my %cmd_opts = (
'virtual_ip' => '-i',
'virtual_hostname' => '-h',
'base_ip' => '-I',
'base_hostname' => '-H',
'virtual_interface' => '-f',
'all_virtual_ip' => '-a',
'all_virtual_hostname' => '-n',
'all_base_ip' => '-A',
'all_base_hostname' => '-N',
'domain' => '-d',
'prefix' => '-p',
'om' => '-O',
'api' => '-P'
);
my $ops = $ncmds->{$vnode}{ovl_params};
my $app_ops;
for my $o (keys %{$ops}){
my $pars = $ops->{$o};
unless(@{$pars} > 0){
XB_Log::log "warning", " [$procname] Overlay parameter $o ".
"has no values! Application deplolyment\n might failed ".
"because of the missing fields.";
}elsif(defined $cmd_opts{$o}){
for my $p (@{$pars}){ $app_ops .= ' '. $cmd_opts{$o}. " $p"; }
}else{
XB_Log::log "warning", " [$procname] Command line switch".
" for parameter $o is not defined!";
}
}
for my $appname (keys %{$ncmds->{$vnode}{app_deploy}}){
XB_Log::log "debug1", " [$procname] starting app \"$appname\"";
my $aapp = $XB_Params::node_state{active_apps}{$type}{$name};
my $script = $aapp->{app_deploy}{$appname}{script};
my $action = $ncmds->{$vnode}{app_deploy}{$appname}{action};
my $suid = $aapp->{app_deploy}{$appname}{suid};
my ($appdir, @args);
unless($script){
XB_Log::log "err", " [$procname] app \"$appname\" script".
" not specified";
die "noscript";
}
unless($suid){
XB_Log::log "warning", " [$procname] app \"$appname\" does".
" not have an suid, use nobody";
$suid = 'nobody';
}
#-> check if doing crash recovery
unless($restore){
#-> create the working directory for the app
($script, $appdir) = XB_AppDeploy::app_dir($name, $appname,
$script, $suid);
$aapp->{app_deploy}{$appname}{script} = $script;
$aapp->{app_deploy}{$appname}{appdir} = $appdir;
#-> install the app if necessary
if($action eq 'install'){
@args = ("-t", "install");
XB_AppDeploy::exec_script($script, \@args, $suid);
$ncmds->{$vnode}{app_deploy}{$appname}{installed} = 1;
}
#-> do configuration
@args = ("-t", "conf", split(" ", $app_ops));
XB_AppDeploy::exec_script($script, \@args, $suid);
}else{
XB_Log::log "debug2", " [$procname] crash recovery, ".
"start the app directly";
}
#-> run the app
@args = ("-t", "run");
XB_AppDeploy::exec_script($script, \@args, $suid);
$ncmds->{$vnode}{app_deploy}{$appname}{started} = 1;
}
}
} #nodes
};
XB_Log::log "info", "<- $modname$procname";
return 1 unless $@;
unless($@ =~ /\b(IPsec|XB_IPsec::add|XB_Dummynet::up|XB_Tunnel::up)\b/ or
$@ =~ /\b(XB_Route::add_route|prefix|ipproto|configure|interface)\b/ or
$@ =~ /\b(XB_Zebra::(get_config|(check|add)_interface|zebra_control))\b/
or $@ =~ /\b(noscript|XB_AppDeploy::(app_dir|exec_script))\b/){
XB_Log::log "warning", " ! $procname caught unknown exception: $@";
}
return 0;
}
# Description:
# [VN] Delete/Undo node commands (links, routes, ipsec) for a given overlay
# Arguments:
# $ctl_cmd (ref) original config command hash to undo
# $restore flag when doing crash recovery
# Returns:
# 1 on success
# 0 on failure
# Exceptions:
# -
# Notes:
# - Only undo node commands with commit bits set in case of a partially
# configured overlay.
# - The order of removal is the exact reverse of config.
# * Each operation must be catch within an "eval" because we want to go
# through all remove operation even if some of them fail.
#
sub undo_node_config($$){
my ($ctl_cmd, $restore) = @_;
my $procname = "undo_node_config";
XB_Log::log "info", "-> $modname$procname $ctl_cmd, $restore";
my $error = 0;
eval{
my $type = $ctl_cmd->{command}{app_type};
my $name = $ctl_cmd->{command}{app_name};
my $ncmds = $ctl_cmd->{command}{node_cmds};
#=> switch on node type: plain, control recursive, real recursive
#if($XB_Param{daemon_type} eq "meta"){
# if($ctl_cmd->{command}{recursion} eq "control"){
# # translate node commands at meta layer into sub-overlay
# }elsif($ctl_cmd->{command}{recursion} eq "true"){
# # translate node commands at meta layer into sub-overlay
# }
#}else{
# # non-recursive node
for my $vnode (keys %{ $ncmds }){
my $routing = $ncmds->{$vnode}{routes}{style};
#-> application deployment
if(defined $ncmds->{$vnode}{app_deploy}){
for my $appname (keys %{$ncmds->{$vnode}{app_deploy}}){
eval{
my $aapp = $XB_Params::node_state{active_apps}{$type}{$name};
my $script = $aapp->{app_deploy}{$appname}{script};
my $suid = $aapp->{app_deploy}{$appname}{suid};
my @args;
unless($script){
XB_Log::log "err", " [$procname] app \"$appname\" has no ".
"script";
die "noscript";
}
unless($suid){
XB_Log::log "warning", " [$procname] app \"$appname\" does".
" not have an suid, use nobody";
$suid = 'nobody';
}
#-> stop it if already started
if($ncmds->{$vnode}{app_deploy}{$appname}{started}){
XB_Log::log "debug1", " [$procname] stopping app ".
"\"$appname\"";
@args = ("-t", "kill");
XB_AppDeploy::exec_script($script, \@args, $suid);
}
#-> don't deinstall/cleanup when doing crash recovery
unless($restore){
#-> cleanup runtime stuff
@args = ("-t", "cleanup");
XB_AppDeploy::exec_script($script, \@args, $suid);
$ncmds->{$vnode}{app_deploy}{$appname}{started} = 0;
#-> deinstalled in installed by this script
if($ncmds->{$vnode}{app_deploy}{$appname}{installed}){
XB_Log::log "debug1", " [$procname] deinstall app ".
"\"$appname\"";
@args = ("-t", "deinstall");
XB_AppDeploy::exec_script($script, \@args, $suid);
$ncmds->{$vnode}{app_deploy}{$appname}{installed} = 0;
}
#-> cleanup the script & application directory
my $appdir = $aapp->{app_deploy}{$appname}{appdir};
if(-f $script){
my @cmd = ('rm', '-f', "$script");
my $rc = 0xff & system (@cmd);
($rc == 0) or
XB_Log::log "err", " [$procname] rm -f $script failed:".
" $!" and die "rm";
}
if(defined $appdir and -d $appdir){
# TODO remove everything? (-f or -rf)
my @cmd = ('rm', '-rf', "$appdir");
my $rc = 0xff & system (@cmd);
($rc == 0) or
XB_Log::log "err", " [$procname] rm -rf $appdir failed".
": $!" and die "rm";
}
}else{
XB_Log::log "debug2", " [$procname] crash recovery, keep".
" the app script and directory";
}
};
unless($@){
XB_Log::log "debug1", " [$procname] app \"$appname\" stopped";
}elsif($@ !~ /(noscript|exec_script|rm)/){
XB_Log::log "warning", " ! $procname caught unknown exception".
": $@";
}
}
}
#-> routes
if($ncmds->{$vnode}{routes}{style} eq "static"){
# static routing
for my $rt (@{$ncmds->{$vnode}{routes}{routes}}){
if($rt->{up}){
my %hash = ( ovlname => $vnode,
routing_method => $routing,
dstarg => "-$rt->{type}",
destination => $rt->{dst},
gateway => $rt->{gw}
);
eval{ XB_Route::delete_route \%hash; };
if($@){
XB_Log::log "warning", " [$procname] $@ failed, continue".
" to remove configuration";
$error = 1;
}
$rt->{up} = 0;
}
# [Batch] push commands into routes
}
} else {
# dynamic routing
XB_Log::log "debug1", "dynamic routing stop";
my @net_interface;
for my $link (keys %{$ncmds->{$vnode}{links}}){
my $ln = $ncmds->{$vnode}{links}{$link};
if ($ln->{net_up} =~ /^(\w+\d+)|/){
my $if = $1;
push @net_interface, $if;
}
}
my $conf = XB_Zebra::get_config($ncmds->{$vnode}{ipproto});
my %hash = ( ovlname => $ctl_cmd->{command}{app_name},
prefix => $ncmds->{$vnode}{routes}{prefixes}->[0],
net_if =>\@net_interface,
conf_file => $conf
);
XB_Log::log "debug1", "Zebra Interface Hash:". Dumper (\%hash);
eval {
# check whether ripd and zebra configure files are installed
my $zebradir = $XB_Params::node_opts{zebra_dir};
my $zebraconf = $zebradir."/zebra.conf";
my $ripdconf = "";
if ($ncmds->{$vnode}{ipproto} eq "ipv4") {
$ripdconf = $XB_Params::node_opts{zebra_dir}."/ripd.conf";
}elsif($ncmds->{$vnode}{ipproto} eq "ipv6") {
$ripdconf = $XB_Params::node_opts{zebra_dir}."/ripngd.conf";
}else {
XB_Log::log "err", "unknown address type!" and die "address_type";
}
(-f $zebraconf) and (-f $ripdconf) or
XB_Log::log "alert","No zebra and ripd configure file in Zebra \
home directory:".$XB_Params::zebra_dir and die "configure";
XB_Zebra::delete_interface(\%hash);
# restart zebra
XB_Zebra::zebra_control ("restart");
};
if($@){
XB_Log::log "warning", " [$procname] $@ failed, continue".
" to remove configuration";
$error = 1;
}
}
#-> links = tunnel + IPsec
for my $link (keys %{$ncmds->{$vnode}{links}}){
my $ln = $ncmds->{$vnode}{links}{$link};
# ipsec
if(defined $ln->{linkaddr}{ipsec} and $ln->{link_ipsec_up}){
my $spi = $ln->{linkaddr}{ipsec}{spi};
# check if IPsec is available on the host
if (not XB_IPsec::is_present) {
XB_Log::log "err", "IPsec is not available on the host!"
and die "IPsec";
}
# IPsec:delete() args:
# fwd: src ip, dst ip, "out", spi
# rev: dst ip, src ip, "in", spi
# forward
eval{ XB_IPsec::delete($ln->{linkaddr}{local},
$ln->{linkaddr}{remote}, "out", $spi); };
if($@){
XB_Log::log "warning", " [$procname] $@ failed, continue".
" to remove configuration";
$error = 1;
}
# reverse
eval{ XB_IPsec::delete($ln->{linkaddr}{remote},
$ln->{linkaddr}{local}, "in", $spi); };
if($@){
XB_Log::log "warning", " [$procname] $@ failed, continue".
" to remove configuration";
$error = 1;
}
$ln->{link_ipsec_up} = 0;
}
# tunnel net
if($ln->{net_up}){
XB_Log::log "debug2", " [$procname] tunnel down: ".
"$ln->{netaddr}{local}, $ln->{netaddr}{remote},\n ".
"$ln->{netaddr}{netmask}, $ln->{linkaddr}{local}, ".
"$ln->{linkaddr}{remote}, net, $vnode, $routing";
eval{ XB_Tunnel::down($ln->{net_up}); };
if($@){
XB_Log::log "warning", " [$procname] $@ failed, continue".
" to remove configuration";
$error = 1;
}
$ln->{net_up} = 0;
}
# tunnel link
if($ln->{link_up}){
XB_Log::log "debug2", " [$procname] tunnel down: ".
"$ln->{linkaddr}{local}, $ln->{linkaddr}{remote},\n ".
"$ln->{linkaddr}{netmask}, $ln->{physical}{local}, ".
"$ln->{physical}{remote}, link, $vnode, $routing";
eval{ XB_Tunnel::down($ln->{link_up}); };
if($@){
XB_Log::log "warning", " [$procname] $@ failed, continue".
" to remove configuration";
$error = 1;
}
$ln->{link_up} = 0;
}
# qos
if (defined $ln->{link_dummynet_up}){
eval {
XB_Dummynet::down ($ln->{link_dummynet_up});
};
if($@){
XB_Log::log "warning", " [$procname] $@ failed, continue".
" to remove dummynet configuration";
$error = 1;
}
$ln->{link_dummynet_up} = undef;
}
# [Batch] push commands into ipsec, tun_link, tun_net
}
# [Batch] do batch processing here
}
};
XB_Log::log "info", "<- $modname$procname";
return 1 unless $error;
return 0;
}
# Description:
# [VN] Probe and return link status of all tunnels through ping.
# Arguments:
# $ctl_cmd (ref) control command hash
# Returns:
# $reply (ref) link status message
# Exceptions:
# "XB_VN_funcs::status_ping" on failure, nothing to cleanup by caller
# Notes:
# Overview: for each link
# - ping remote end of net tunnel
# - if failed, ping remote end of link tunnel
# - if failed, ping remote end of physical addr
#
sub status_ping($){
my $cmd = shift;
my $procname = "status_ping";
XB_Log::log "info", "-> $modname$procname $cmd";
my $reply;
eval{
my $ncmds = $cmd->{command}{node_cmds};
my ($lmsg);
#if(recursion){
# meta node
# not yet
#}else{
# simple node
for my $vnode (keys %{ $ncmds }){
# check links
for my $link (keys %{$ncmds->{$vnode}{links}}){
my $ln = $ncmds->{$vnode}{links}{$link};
my $nl = $ln->{netaddr}{local};
my $nr = $ln->{netaddr}{remote};
my $ll = $ln->{linkaddr}{local};
my $lr = $ln->{linkaddr}{remote};
my $pl = $ln->{physical}{local};
my $pr = $ln->{physical}{remote};
$ln->{netaddr}{ping} = "up";
$ln->{linkaddr}{ping} = "up";
$ln->{physical}{ping} = "up";
if ($ncmds->{$vnode}{ipproto} eq 'ipv4'){
if ($XB_Params::node_opts{NODEOS} =~ /freebsd|linux/i) {
my $ping = Net::Ping->new("icmp");
if($ping->ping($nr)){
# ping ovl network endpoint
XB_Log::log "debug2",
" [$procname] ping ovl net: $nr ok";
}elsif($ping->ping($lr)){
# only ping overlay link if overlay net is down
$ln->{netaddr}{ping} = "down";
XB_Log::log "debug2",
" [$procname] ping ovl link: $lr ok";
}elsif($ping->ping($pr)){
# only ping phy is both overlay net & link are down
$ln->{netaddr}{ping} = "down";
$ln->{linkaddr}{ping} = "down";
XB_Log::log "debug2",
" [$procname] ping ovl phy: $pr ok";
}else{
XB_Log::log "warning",
" [$procname] physcial connection to $pr is down";
$ln->{netaddr}{ping} = "down";
$ln->{linkaddr}{ping} = "down";
$ln->{physical}{ping} = "down";
}
} elsif ($XB_Params::node_opts{NODEOS} =~ /cisco/i) {
my $ping;
if($ping = XB_CiscoSSH::ping $nr){
# ping ovl network endpoint
XB_Log::log "debug2",
" [$procname] ping ovl net: $nr ok";
} elsif($ping = XB_CiscoSSH::ping $lr){
# only ping overlay link if overlay net is down
$ln->{netaddr}{ping} = "down";
XB_Log::log "debug2",
" [$procname] ping ovl link: $lr ok";
} elsif($ping = XB_CiscoSSH::ping $pr){
# only ping phy is both overlay net & link are down
$ln->{netaddr}{ping} = "down";
$ln->{linkaddr}{ping} = "down";
XB_Log::log "debug2",
" [$procname] ping ovl phy: $pr ok";
} else{
XB_Log::log "warning",
" <$procname> physcial connection to $pr is down";
$ln->{netaddr}{ping} = "down";
$ln->{linkaddr}{ping} = "down";
$ln->{physical}{ping} = "down";
}
}
}elsif($XB_Params::node_opts{NODEOS} =~ /freebsd/i){
my @ping6 = ("ping6", "-q", "-n", "-c 1", $nr);
if(not (0xff & system @ping6)){
XB_Log::log "debug2",
" [$procname] ping ovl net: $nr ok";
}elsif(not (0xff & system("ping6", "-q", "-n", "-c 1", $lr))){
$ln->{netaddr}{ping} = "down";
XB_Log::log "debug2",
" [$procname] ping ovl link: $lr ok";
}elsif(not (0xff & system("ping6", "-q", "-n", "-c 1", $pr))){
$ln->{netaddr}{ping} = "down";
$ln->{linkaddr}{ping} = "down";
XB_Log::log "debug2",
" [$procname] ping ovl phy: $pr ok";
}else{
XB_Log::log "warning",
" [$procname] physcial connection to $pr is down";
$ln->{netaddr}{ping} = "down";
$ln->{linkaddr}{ping} = "down";
$ln->{physical}{ping} = "down";
}
}else{
XB_Log::log "warning", " [$procname] don't know how to ping6 ".
"on $XB_Params::node_opts{NODEOS}";
$ln->{netaddr}{ping} = "unknown";
$ln->{linkaddr}{ping} = "unknown";
$ln->{physical}{ping} = "unknown";
}
$lmsg .=
" ($link (interface $ln->{interface})\n".
" (netaddr $nl $nr $ln->{netaddr}{ping})\n".
" (linkaddr $ll $lr $ln->{linkaddr}{ping})\n".
" (physical $pl $pr $ln->{physical}{ping})\n".
" )\n";
} #links
# how to check route?
# construct status message for this virtual node
$reply .=
" (vnode $vnode\n".
" (link\n". $lmsg.
" )\n".
" )\n";
XB_Log::log "debug1", " [$procname] status ping: \n$reply";
}
#} #if(recursion)
};
XB_Log::log "info", "<- $modname$procname";
return \$reply unless $@;
unless($@ =~ /\S/){
XB_Log::log "warning", " ! $procname caught unknown exception: $@";
}
die "$modname$procname"
}
1;
syntax highlighted by Code2HTML, v. 0.9.1