### 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;