### 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_CTL.pm,v $ # # $Revision: 1.41 $ # $Author: pingali $ # $Date: 2005/03/31 07:03:50 $ # $State: Exp $ # ---------------------------------------------------------------------------- # # Primary Author: Yu-Shun Wang # Description: Functions for processing XBone Control commands package XB_CTL; require Exporter; @ISA = qw(Exporter); @EXPORT = qw(); @EXPORT_OK = qw(xb_control_invite ctl_select ctl_config xb_control_release ctl_stop ctl_refresh ctl_status); use strict; use sigtrap; use Socket; use Socket6; use XB_Params; use XB_Log; #use XB_API; #use XB_Common; #use XB_SMIME; use Data::Dumper; my $modname = "XB_CTL::"; ############################################################################### # UTILITY FUNCTIONS ############################################################################### # Description: # Check request against supported address types (combinations of IPv4/IPv6). # Arguments: # $reqd # $conf # Returns: # 1 on success # 0 on failure # Exceptions: # - sub match_addr_type($$){ my ($reqd, $conf) = @_; return 0 if ($reqd !~ /^(ipv6|ipv4)$/); return 0 if ($conf !~ /^(ipv6|ipv4|v4overv6|v6overv4|overv6|overv4|both)$/); return 1 if ( (($reqd =~ /^(ipv4)$/) and ($conf =~ /^(ipv4|overv4|both)$/)) or (($reqd =~ /^(ipv6)$/) and ($conf =~ /^(ipv6|overv6|both)$/)) ); return 0; } # Description: # Verify control command against node state for app type, name, level, # sender, etc. # Arguments: # $cmd (ref) control command # Returns: # @ [state, type, name, level, sender, hostname) # Exceptions: # "verify_state" on failure, nothing to cleanup by caller # Note: # implicitly uses %XB_Params::node_state # sub verify_state($){ my $cmd = shift; my $procname = "verify_state"; XB_Log::log "info", "-> $procname $cmd"; my ($state, $type, $name, $level, $creator, $hostname); my ($command, $ctype, $cname, $clevel, $sender); eval{ #=> get arguments (save some typing) $state = $XB_Params::node_state{state}; $type = $XB_Params::node_state{application}; $name = $XB_Params::node_state{name}; $level = $XB_Params::node_state{level}; $creator= $XB_Params::node_state{creator}; $hostname = $XB_Params::node_opts{hostname}; $command = $cmd->{command}{command}; $ctype = $cmd->{command}{app_type}; $cname = $cmd->{command}{app_name}; $clevel= $cmd->{command}{level}; $sender = $cmd->{sender}; XB_Log::log "debug1", " [$procname] values: [state/app/name/level/creator]\n". " [$procname] state: [$state/$type/$name/$level/$creator]\n". " [$procname] command:[$command/$ctype/$cname/$clevel/$sender]"; #=> check application type unless($type eq $ctype){ XB_Log::log "err", " [$procname] Unable to perform configuration ". "step. Inconsistent information across successive messages from ". "the overlay manager. wrong app: $type <> $ctype"; die "app"; } #=> check application name unless($name eq $cname){ XB_Log::log "err", " [$procname] Unable to perform configuration ". "step. Inconsistent information across successive messages from ". "the overlay manager. wrong app: $name <> $cname"; die "name"; } #=> check sender unless($creator eq $sender){ XB_Log::log "err", " [$procname] Unable to perform configuration ". "step. Inconsistent information across successive messages from ". "the overlay manager. wrong sender: $creator <> $sender"; die "creator"; } #=> check level unless($level == $clevel){ XB_Log::log "err", " [$procname] Unable to perform configuration ". "step. Inconsistent information across successive messages from ". "the overlay manager. wrong level: $level <> $clevel"; die "level"; } #=> check state $_ = $command; SWITCH: { /\bselect\b/ && do { if($state eq "idle"){ # TODO need to do ACL & resource checks to go directly from idle # TODO to select, ok for now }elsif($state ne "reserve"){ XB_Log::log "err", " [$procname] Unable to perform ". "configuration step. wrong state: $state"; die "state"; } last SWITCH; }; /\bdispatch\b/ && do { unless($state eq "select"){ XB_Log::log "err", " [$procname] Unable to perform ". "configuration step. wrong state: $state"; die "state"; } last SWITCH; }; /\bconfig\b/ && do { unless($state eq "select" or $state eq "commit"){ XB_Log::log "err", " [$procname] Unable to perform ". "configuration step. wrong state: $state"; die "state"; } last SWITCH; }; XB_Log::log "warning", " [$procname] Unable to perform ". "configuration step. unknown command: $_ ignored"; } }; XB_Log::log "info", "<- $procname "; return ($state, $ctype, $cname, $clevel, $sender, $hostname) unless $@; if($@ !~ /(app|name|creator|level|state)/){ XB_Log::log "warning", " ! $procname caught unkown exception: $@"; } die "$procname"; } ############################################################################### # EXPORTED API ############################################################################### # Description: # [CTL] Process XBone multicast invite command # Arguments: # $cmd (ref) multicast Invite Command # Returns: # 1 on success # 0 on failure # Exceptions: # XB_CTL::xb_control_invite on failure, nothing to cleanup by caller sub xb_control_invite ($){ my $cmd = shift; my $procname = $modname. "ctl_invite"; XB_Log::log "info", "-> $procname $cmd"; my ($app_type, $app_name); eval{ my $state = $XB_Params::node_state{state}; $app_type = $cmd->{command}{app_type}; $app_name = $cmd->{command}{app_name}; my $app_vers = $cmd->{command}{app_vers}; my $level = $cmd->{command}{level}; #=> Note: other checks (versions, app type, acl, etc.) were already done # before calling this function #=> if idle unless($state =~ /\b(idle)\b/i){ XB_Log::log "err", " [$procname] Unable to process invite request ". "from the overlay manager. in $state state for ". "$XB_Params::node_state{name} by $XB_Params::node_state{creator}"; die "state"; } #=> if app/name exists if(exists $XB_Params::node_state{active_apps}{$app_type}{$app_name}){ XB_Log::log "err", " [$procname] Unable to process invite request ". "from the overlay manager. $app_type $app_name already exists"; die "dupl"; } #=> resource check - address type: IPv4/IPv6 my $addr_type = $cmd->{command}{addr_type}; unless(match_addr_type($addr_type, $XB_Params::node_opts{address_type})){ XB_Log::log "err", " [$procname] Unable to process invite request ". "from the overlay manager. unsupported address type: $_"; die "ip"; } #=> resource check - node type my $type = $XB_Params::node_opts{daemon_type}; $cmd->{command}{node}{count} = $cmd->{command}{host}{count} + $cmd->{command}{router}{count}; unless($cmd->{command}{$type}{count}){ XB_Log::log "err", " [$procname] Unable to process invite request ". "from the overlay manager. not my (node) type"; die "type"; } #=> resource check - platform if($type =~ /(host|router)/i){ unless(XB_Common::check_list($XB_Params::node_opts{os}, $cmd->{command}{$type}{platform})){ XB_Log::log "err", " [$procname] platform doesn't match"; die "platform"; } }elsif($type eq 'node'){ if(XB_Common::check_list($XB_Params::node_opts{os}, $cmd->{command}{host}{platform})){ $type = 'host'; } if(XB_Common::check_list($XB_Params::node_opts{os}, $cmd->{command}{router}{platform})){ $type = ($type eq 'node')? 'router' : 'node'; } unless($type eq 'node'){ XB_Log::log "debug2", " [$procname] ack with effective node ". "type \"$type\""; } }elsif($type eq 'meta'){ # don't care about meta node's platform for now } #=> resource check - QoS => TODO Wait for node_opt @ init if (($addr_type =~ /ipv6/ or $XB_Params::node_opts{qos} =~ /no/i) and $cmd->{command}{qos} =~ /yes/){ XB_Log::log "err", " [$procname] Unable to process invite request ". "from the overlay manager. QoS not supported on this platform"; die "qos"; } #=> resource check - routing => TODO Wait for node_opt @ init #=> resource check - IPsec => TODO Wait for node_opt @ init if ($cmd->{command}{ipsec} =~ /yes/ and ((!XB_IPsec::is_present()) or ($XB_Params::node_opts{IPsec} =~ /no/i))){ XB_Log::log "err", " [$procname] Unable to process invite request ". "from the overlay manager. IPsec not supported on this platform"; die "ipsec"; } #=> resource check - application deployment my $app_deploy_str = ''; if(defined $cmd->{command}{app_deploy}){ for my $appname (keys %{$cmd->{command}{app_deploy}}){ my $aapp = $XB_Params::node_state{active_apps}; #-> verify suid my $spoiled = 0; my $cmd_suid = (defined $cmd->{command}{app_deploy}{$appname}{suid})? $cmd->{command}{app_deploy}{$appname}{suid}: ''; my $acl_suid = $cmd->{user_acl}{suid}; my $final_suid; #-- if the command did not specify an suid, use the highest allowed # by acl or lowest possible (nobody), depending on the param #-- otherwise, the order is 'root' > 'vhost' > 'nobody' in the # following comparison if($acl_suid eq 'none'){ XB_Log::log "err", " [$procname] Application deployment is not". " allowed on this node."; die 'app'; }elsif($cmd_suid eq ''){ $final_suid = ($XB_Params::HIGHEST_ACL_SUID)? $acl_suid:'nobody'; }elsif($acl_suid eq 'vhost'and $cmd_suid eq 'root'){ $spoiled = 1; }elsif($acl_suid eq 'nobody' and $cmd_suid ne 'nobody'){ $spoiled = 1; }else{ $final_suid = $cmd_suid; } if($spoiled){ XB_Log::log "err", " [$procname] requsted app script privilege". ", $cmd_suid, is higher than acl, $acl_suid"; die "suid"; } $aapp->{$app_type}{$app_name}{app_deploy}{$appname}{suid} = $final_suid; #-> get the script my $chksum = (defined $cmd->{command}{app_deploy}{$appname}{chksum})? $cmd->{command}{app_deploy}{$appname}{chksum}: ''; my $script = XB_AppDeploy::get_script( $cmd->{command}{app_deploy}{$appname}{url}, $XB_Params::node_opts{workdir}, $chksum); $aapp->{$app_type}{$app_name}{app_deploy}{$appname}{url} = $cmd->{command}{app_deploy}{$appname}{url}; $aapp->{$app_type}{$app_name}{app_deploy}{$appname}{script} = $script; $aapp->{$app_type}{$app_name}{app_deploy}{$appname}{chksum} = $chksum; #-> verify if we could run the app my @args = ('-t', 'verify'); my $verify = XB_AppDeploy::exec_script($script, \@args, 'nobody'); if($verify >= 2){ XB_Log::log "err", " [$procname] can not support application ". "\"$appname\""; die "app"; } #-> passed all check, construct the app section in ack-invite my $app_result = ($verify == 0)? "ok" : "install"; $app_deploy_str .= " (app-deploy\n". " (name $appname)\n". " (app_verify $app_result))\n"; } } #=> resource check - others => What else? #=> passed all resource check, gather remaining fields for ack_invite #=> hostname my $hostname = $XB_Params::node_opts{hostname}; my $ipproto = $cmd->{command}{addr_type}; my ($ctl_addr, $app_addr); #=> ctl_addr: same as multicast IP protocol version if($ipproto eq "ipv6"){ $ctl_addr = $XB_Params::node_opts{ctl_addr6}; $app_addr = $XB_Params::node_opts{app_addr6}; }else{ $ctl_addr = $XB_Params::node_opts{ctl_addr}; $app_addr = $XB_Params::node_opts{app_addr}; } #=> create ack_invite message my $seq = $cmd->{sequence}[0]; my $reply = "(xbone-ctl $XB_Params::ctl_ver $XB_Params::rel_ver $seq\n". " (ack-invite\n". " (application $app_type)\n". " (name $app_name)\n". " (version $app_vers)\n". " (level $level)\n". " (type $type)\n". " (hostname $hostname)\n". " (addr_type $addr_type)\n". " (ctl_addr $ctl_addr)\n". " (app_addr $app_addr)\n". " (os $XB_Params::node_opts{NODEOS})\n". " (os_version $XB_Params::node_opts{os_version})\n". " (kernel $XB_Params::node_opts{kern_version})\n". $app_deploy_str. " )\n". ")\n$XB_Params::msg_delimiter\n"; #print "MSG: $reply"; #=> sign the message with S/MIME my $smime_reply = XB_SMIME::sign($reply, $XB_Params::node_opts{"node_cert"}, $XB_Params::node_opts{"node_key"}); #=> create socket & send the message my $udp_sock = XB_Common::udp_sock($cmd->{sender_ip}, $XB_Params::node_opts{xbone_ctl_port}, $ipproto); unless (send ($udp_sock, $smime_reply, 0)){ XB_Log::log "err", " [$procname] Operating system resource ". "error while responding to to invite request from ". "$cmd-{sender}: $!" and die "send"; } XB_Log::log "info", " [$procname] sent udp ack-invite to $cmd->{sender}"; #=> enter reserve state & start time $XB_Params::node_state{state} = "reserve"; $XB_Params::node_state{application} = $app_type; $XB_Params::node_state{name} = $app_name; $XB_Params::node_state{creator} = $cmd->{sender}; $XB_Params::node_state{start} = time; $XB_Params::node_state{level} = $level; XB_Log::log "debug1", " [$procname] State: ". Dumper(\%XB_Params::node_state); XB_Log::log "info", " [$procname] enter reserve state for $app_name, ". "level $level"; # TODO set timeout in XB_Params.pm # TODO check timer in main loop #=> close the socket $udp_sock->close or XB_Log::log "err", " [$procname] Unable cleanup after responding ". "to the overlay manager's invite request. close $udp_sock ". "failed: $!" and die "close"; }; XB_Log::log "info", "<- $procname"; return 1 unless $@; if(exists $XB_Params::node_state{active_apps}{$app_type}{$app_name} and $@ ne 'dupl'){ XB_Common::cleanup_app($app_type, $app_name); } print "STATE: ". Dumper(\%XB_Params::node_state). "\n"; unless ($@ =~ /(state|dupl|ip|type|qos|ipsec|get_script|exec_script|suid|app)/ or $@ =~ /(sign|udp_sock|send|close)/){ XB_Log::log "warning", " ! $procname caught unknown exception". " $@"; } die "$procname"; } # Description: # [CTL] Process XBone control select command # Arguments: # $cmd (ref) control select Command # Returns: # \$ack_msg (ref) control ack message # Exceptions: # "XB_CTL::ctl_select" on failure, caller should clear the state # sub ctl_select($){ my ($cmd) = shift; my $procname = "ctl_select"; my $ack_msg; XB_Log::log "info", "-> $modname$procname $cmd"; eval{ #=> verify state & application info my ($state, $type, $name, $level, $sender, $hostname) = verify_state $cmd; #=> enter select state $XB_Params::node_state{state} = "select"; $XB_Params::node_state{start} = time; XB_Log::log "info", " [$procname] Select: $type, $name level $level by $sender"; #=> construct ack-select message $ack_msg = XB_Common::ctl_msg('ack-select', $type, $name, $level, $hostname); }; XB_Log::log "info", "<- $modname$procname"; return $ack_msg unless $@; unless ($@ =~ /verify_state/){ XB_Log::log "warning", " ! $procname caught unknown exception: $@"; } die"$modname$procname"; } # Description: # [CTL] Process XBone control dispatch command # - execute API invite, select, release, dispatch # - return ack-dispatch or nack-dispatch error # Arguments: # $ctl_cmd (ref) control select Command # $api_cmd (ref) API command to recurse # $sock socket handle to send ack-dispatch back # $mcast_sock multicast socket to to do multicast invite # Returns: # 1 on success # 0 on failure # Exceptions: # - sub xb_control_dispatch($$$$){ my ($ctl_cmd, $api_cmd, $sock, $mcast_sock) = @_; my $procname = "xb_control_dispatch"; my ($app_obj, $avail); XB_Log::log "info", "-> $modname$procname $api_cmd, $sock"; eval{ #=> check state & get arguments my ($state, $app_type, $app_name, $app_level, $sender) = verify_state($ctl_cmd); $api_cmd->{command}{level} = $ctl_cmd->{command}{level}+1; $api_cmd->{command}{retry} = $ctl_cmd->{command}{retry}; #=> similar to xb_api_start, but cut off after dispatch my ($app_obj, $avail); #=> [0] Initialization $app_obj = XB_API::api_init $api_cmd; XB_Log::log "debug6", Dumper($app_obj). "\n"; #=> [1] Invite $avail = XB_API::api_invite $app_obj, $mcast_sock; XB_Log::log "debug6", Dumper($avail). "\n"; #=> [2] Select XB_API::xb_api_select($app_obj, $avail, $sock); #=> [3.1] Release XB_API::xb_api_release($app_obj, $app_obj->{resources}{level}, $mcast_sock); #=> [3.2] Dispatch if($app_obj->{resources}{meta}){ XB_API::xb_api_dispatch($app_obj); } #=> construct ack-dispatch message # get some info required at the upper level my ($addr_ranges, $export_iflist); my $addrblks = $app_obj->{application}{network}{properties}{addr_blk_all}; for my $a (@{$addrblks}){ $addr_ranges .= "(addressrange $a)\n"; } my %export_ifs; #for my $i (keys %{$app_obj->{applications}{network}{interfaces}}){ # my $n = $app_obj->{applications}{network}{interfaces}{$i}{node}; # for my $r (@{$app_obj->{resources}{ # $export_ifs{$i}{ my $ack_dispatch = " (xbonecontrol $XB_Params::ctl_ver $XB_Params::rel_ver (ack-dispatch (application $app_type) (name $app_name) (level $app_level) $addr_ranges))\n$XB_Params::msg_delimiter\n"; #=> send the message back XB_Log::log "info", " [$procname] send ack-dispatch to $sender"; unless((ref($sock) eq "IO::Socket::SSL") or (ref($sock) eq "IO::Socket::SSLv6")){ XB_Log::log "warning", " [$procname] wrong socket type: ".ref($sock); } print $sock "$ack_dispatch"; #=> enter commit state $XB_Params::node_state{state} = "commit"; $XB_Params::node_state{start} = time; #=> commit $app_obj into node_state $XB_Params::node_state{active_apps}{$app_type}{$app_name}{network} = $app_obj; print "+++ ", Dumper(\%XB_Params::node_state), "\n"; print "--- ", Dumper($XB_Params::node_state), "\n"; XB_Log::log "info", " [$procname] enter commit state: $app_type, ". "$app_name, level $app_level by $sender"; }; XB_Log::log "info", "<- $modname$procname"; return 1 unless $@; my $ack_dispatch = " (xbonecontrol $XB_Params::ctl_ver $XB_Params::rel_ver (ack-dispatch (application overlay) (name test.xbone.net) (level 1)))\n$XB_Params::msg_delimiter\n"; #=> send the message back #XB_Log::log "info", " [$procname] send ack-dispatch to $sender"; unless((ref($sock) eq "IO::Socket::SSL") or (ref($sock) eq "IO::Socket::SSLv6")){ XB_Log::log "warning", " [$procname] wrong socket type: ".ref($sock); } print $sock "$ack_dispatch"; unless ($@ =~ /(verify_state)/){ XB_Log::log "warning", " ! $procname caught unknown exception: $@"; } die "$procname"; } # Description: # [CTL] Process XBone control config command & perform node config # Arguments: # $cmd (ref) control config command # Returns: # \$ack_msg (ref) control ack message # $restore flag indicating doing crash recovery # Exceptions: # "XB_CTL::ctl_config" on failure, caller should clear the state # Notes: # sub ctl_config($$){ my ($cmd, $restore) = @_; my $procname = "ctl_config"; my $ack_msg; XB_Log::log "info", "-> $modname$procname $cmd"; eval{ #=> check state & get arguments my ($state, $type, $name, $level, $sender, $hostname); unless($restore){ ($state, $type, $name, $level, $sender, $hostname) = verify_state $cmd; }else{ $type = $cmd->{command}{app_type}; $name = $cmd->{command}{app_name}; $level= $cmd->{command}{level}; $sender = $cmd->{sender}; $hostname = $XB_Params::node_opts{hostname}; } my $succeed = 0; #=> perform app-specific configs $_ = $type; SWITCH: { /\boverlay\b/ && do{ $succeed = XB_VN_funcs::exec_node_config($cmd, $restore); last SWITCH; }; XB_Log::log "err", " [$procname] Unable to configure host. ". "Unsupported application: $_"; die "app"; } if($succeed){ # construct ack-select message $ack_msg = XB_Common::ctl_msg('ack-config', $type, $name, $level, $hostname); # commit the hash (save the config command hash) $XB_Params::node_state{active_apps}{$type}{$name}{node} = $cmd; my $user_email = $cmd->{credential}{user_email}; unless($restore){ $XB_Params::node_state{user_stats}{$user_email}++; } # set the expire time $XB_Params::node_state{active_apps}{$type}{$name}{expire} = time + $XB_Params::expire; # reset the state to idle XB_Common::reset_state; # update the state file XB_Common::record_state; }else{ # failed, delete/undo configuration $_ = $type; SWITCH:{ /\boverlay\b/ && do{ XB_VN_funcs::undo_node_config($cmd, 0); last SWITCH; }; XB_Log::log "err", " [$procname] Unable to deconfigure host. ". "Unsupported application: $_"; } XB_Common::reset_state; # then we die die "failed"; } }; XB_Log::log "info", "<- $modname$procname"; return $ack_msg unless $@; unless ($@ =~ /(verify_state|app|failed)/){ XB_Log::log "warning", " ! $procname caught unknown exception: $@"; } die "$modname$procname"; } # Description: # [CTL] Process XBone multicast release command # Arguments: # $cmd (ref) multicast release Command # Returns: # 1 on success # 0 on failure # Exceptions: # - sub xb_control_release($){ my $cmd = shift; my $procname = "xb_control_release"; XB_Log::log "info", "-> $modname$procname $cmd"; eval{ #print "##### ", Dumper(\%XB_Params::node_state), "\n"; #=> get arguments (save some typing) my $state = $XB_Params::node_state{state}; my $s_type = $XB_Params::node_state{application}; my $s_name = $XB_Params::node_state{name}; my $s_level= $XB_Params::node_state{level}; my $creator= $XB_Params::node_state{creator}; my $c_type = $cmd->{command}{app_type}; my $c_name = $cmd->{command}{app_name}; my $c_level= $cmd->{command}{level}; my $sender = $cmd->{sender}; #=> check state unless($state eq "reserve"){ XB_Log::log "warning", " [$procname] not in reserve state, ignore"; die "state"; } #=> check application type unless($s_type eq $c_type){ XB_Log::log "warning", " [$procname] wrong app: $s_type vs. $c_type"; die "app"; } #=> check application name unless($s_name eq $c_name){ XB_Log::log "warning", " [$procname] wrong name, $s_name vs. $c_name"; die "name"; } #=> check sender unless($creator eq $sender){ XB_Log::log "warning", " [$procname] wrong creator, $creator vs. $sender"; die "creator"; } #=> check level unless($s_level <= $c_level){ XB_Log::log "warning", " [$procname] lower level ($s_level > $c_level) ". "probably retransmission"; die "level"; } #=> release (passed all checks, must release now XB_Common::reset_state; XB_Common::cleanup_app($s_type, $s_name); XB_Log::log "info", " [$procname] release $c_type $c_name, level ". "$c_level by $sender"; }; XB_Log::log "info", "<- $modname$procname"; return 1 unless $@; unless ($@ =~ /(state|app|name|creator|level)/){ XB_Log::log "warning", " ! $procname caught unknown exception: $@"; } return 0; # don't need to die } # Description: # [CTL] Process XBone control stop command # Arguments: # $type application type # $name application name # $level application level # $serder sender of the command # $keep flag to keep the state (for pre-restoration cleanup) # Returns: # 1 on success # 0 on failure # Exceptions: # - sub ctl_stop($$$$$){ my ($type, $name, $level, $sender, $keep) = @_; my $procname = "ctl_stop"; my $ack_msg; XB_Log::log "info", "-> $modname$procname $type, $name, $level, $sender,". " $keep"; eval{ my $deleted = 0; my $hostname = $XB_Params::node_opts{hostname}; my $msg; if(defined $XB_Params::node_state{active_apps}{$type}{$name}){ #-> app/name exists, should have already been configured #-> RD or sub-OM: # > RD: o node_state{active_apps}{type}{name}{node} # o undo node config # > OM: o node_state{active_apps}{type}{name}{network} # o call api_stop #-- switch on app type & perform app-specific delete my $active_apps = $XB_Params::node_state{active_apps}; my $ctl_cmd = $active_apps->{$type}{$name}{node}; $_ = $type; SWITCH: { /\boverlay\b/ && do{ $deleted = XB_VN_funcs::undo_node_config($ctl_cmd, $keep); last SWITCH; }; XB_Log::log "err", " [$procname] Unable to stop the application ". "at this node. Unsupported application: $_"; die "app"; } unless($keep){ delete $XB_Params::node_state{active_apps}{$type}{$name}; my $user_email = $ctl_cmd->{credential}{user_email}; if($XB_Params::node_state{user_stats}{$user_email}){ $XB_Params::node_state{user_stats}{$user_email}--; } }elsif(not $deleted){ XB_Log::log "warning", " [$procname] delete failed; proceed ". "with crash recovery"; $deleted = 1; } }else{ #-> app/name does not exists, have not been configured #-> call verify_state, if die, then we don't know this apps! #-> get arguments (save some typing) my $state = $XB_Params::node_state{state}; my $s_type = $XB_Params::node_state{application}; my $s_name = $XB_Params::node_state{name}; my $s_level= $XB_Params::node_state{level}; my $creator= $XB_Params::node_state{creator}; # TODO if(nested obj) sends out stop recursively if(($type eq $s_type ) and ($name eq $s_name)){ # same application type & name, currently deploying it if($state eq "config"){ XB_Log::log "warning", " [$procname] in config state, weird"; # remove on going configuration } $deleted = 1; XB_Log::log "info", " [$procname] state for $type $name, level ". "$level cleared by $sender"; #=> check sender unless($creator eq $sender){ XB_Log::log "warning", " [$procname] wrong creator, $creator ". "vs. $sender"; $msg = "State established by $creator, deleted by $sender\n"; } #=> check level unless($s_level == $level){ XB_Log::log "warning", " [$procname] wrong level ($s_level vs. ". "$level)"; $msg .= "Wrong level, state has $s_level, command has $level.\n"; } } unless ($deleted){ # did not find the corresponding app/name, send warning XB_Log::log "err", " [$procname] could not find $type $name"; $msg .= "Could not find $type $name.\n"; } } #-> construct ack-select message $ack_msg = XB_Common::ctl_msg('ack-stop', $type, $name, $level, $hostname); #-> reset the state to idle XB_Common::reset_state; #-> update the state file XB_Common::record_state; #-> check for failure unless($deleted){ die "delete"; } }; XB_Log::log "info", "<- $modname$procname"; return $ack_msg unless $@; unless ($@ =~ /(app|delete)/){ XB_Log::log "warning", " ! $procname caught unknown exception: $@"; } die "$modname$procname"; } # Description: # [CTL] Process XBone control status command # - ping each remote end of the tunnel # Arguments: # $type application type # $name application name # $level application level # $serder sender of the command # Returns: # 1 on success # 0 on failure # Exceptions: # - sub ctl_status($$$$){ my ($type, $name, $level, $sender) = @_; my $procname = "ctl_status"; my $ack_msg; XB_Log::log "info", "-> $modname$procname $type, $name, $level, $sender"; eval{ my $hostname = $XB_Params::node_opts{hostname}; if(defined $XB_Params::node_state{active_apps}{$type}{$name}){ #-- switch on app type & perform app-specific delete my $active_apps = $XB_Params::node_state{active_apps}; # TODO could be node or network! vvvv my $ctl_cmd = $active_apps->{$type}{$name}{node}; my $status; $_ = $type; SWITCH: { /\boverlay\b/ && do{ $status = XB_VN_funcs::status_ping($ctl_cmd); last SWITCH; }; XB_Log::log "err", " [$procname] Unable to gather status ". "information. Unsupported application: $_"; die "app"; } $ack_msg = XB_Common::ctl_msg('ack-status', $type, $name, $level, $hostname, $$status); }else{ XB_Log::log "err", " [$procname] Unable to gather status ". "information. $type $name does not exist!"; die "exist"; } #print "Dump: ". $$ack_msg; }; XB_Log::log "info", "<- $modname$procname"; return $ack_msg unless $@; unless ($@ =~ /(exist|app)/){ XB_Log::log "warning", " ! $procname caught unknown exception: $@"; } die "$modname$procname"; } # Description: # [CTL] Process XBone multicast discover command, report a summary of # current node states. # Arguments: # $cmd (ref) multicast Discover Command # Returns: # 1 on success # 0 on failure # Exceptions: # XB_CTL::ctl_discover on failure, nothing to cleanup by caller sub ctl_discover ($){ my $cmd = shift; my $procname = "ctl_discover"; XB_Log::log "info", "-> $modname$procname $cmd"; eval{ #=> gather some statistics #-- active overlays my @app_list = keys %{$XB_Params::node_state{active_apps}{overlay}}; my $app_count = @app_list; my $ovl = $XB_Params::node_state{active_apps}{overlay}; #-- active tunnels my $tun_count = 0; for my $a (@app_list){ if(exists $ovl->{$a}{node}{command}){ while(my ($k, $v) = each %{$ovl->{$a}{node}{command}{node_cmds}}){ $tun_count += scalar (keys %{$v->{links}}) * 2; } } } #-- IP version support: my $caddr4 = " (ctl_addr $XB_Params::node_opts{ctl_addr})\n"; my $caddr6 = " (ctl_addr6 $XB_Params::node_opts{ctl_addr6})\n"; my $aaddr4 = " (app_addr $XB_Params::node_opts{app_addr})\n"; my $aaddr6 = " (app_addr6 $XB_Params::node_opts{app_addr6})\n"; my $addr_str = ""; if($XB_Params::node_opts{ipproto} eq "both"){ $addr_str = $caddr4. $aaddr4. $caddr6. $aaddr6; }elsif($XB_Params::node_opts{ipproto} eq "ipv4"){ $addr_str = $caddr4. $aaddr4; }else{ $addr_str = $caddr6. $aaddr6; } my $class = "simple"; if($XB_Params::node_opts{daemon_type} eq "meta"){ $class = "meta"; } #=> create ack_invite message my $seq = $cmd->{sequence}[0]; my $ipsec = $XB_Params::node_opts{IPsec}; if ($ipsec =~ /yes/i and ! XB_IPsec::is_present()){ $ipsec = "no"; } my $reply = "(xbone-ctl $XB_Params::ctl_ver $XB_Params::rel_ver $seq\n". " (ack-discover\n". " (hostname $XB_Params::node_opts{hostname})\n". " (Class $class)\n". " (os $XB_Params::node_opts{NODEOS})\n". " (os_version $XB_Params::node_opts{os_version})\n". " (kernel $XB_Params::node_opts{kern_version})\n". $addr_str. " (xol_vers $XB_Params::xol_ver)\n". " (node_type $XB_Params::node_opts{daemon_type})\n". " (ipproto $XB_Params::node_opts{ipproto})\n". " (routing $XB_Params::node_opts{routing})\n". " (IPsec $ipsec)\n". " (qos $XB_Params::node_opts{qos})\n". " (dns $XB_Params::node_opts{dns})\n". " (overlay $app_count)\n". " (tunnel $tun_count)\n". " )\n". ")\n$XB_Params::msg_delimiter\n"; #=> sign the message with S/MIME my $smime_reply = XB_SMIME::sign($reply, $XB_Params::node_opts{"node_cert"}, $XB_Params::node_opts{"node_key"}); #=> create UDP socket based on the multicast ipproto my $udp_sock = XB_Common::udp_sock($cmd->{sender_ip}, $XB_Params::node_opts{xbone_ctl_port}, $cmd->{control_protocol}); #=> send message unless (send ($udp_sock, $smime_reply, 0)){ XB_Log::log "err", " [$procname] Unable to process discover ". "request. Error while responding to $cmd->{sender}: $!" and die "send"; } XB_Log::log "info", " [$procname] sent ack-discover to $cmd->{sender}"; #=> close the socket $udp_sock->close or XB_Log::log "err", " [$procname] Unable to cleanup after ". "responding to the $cmd->{sender} discover request. ". "close $udp_sock failed: $!" and die "close"; }; XB_Log::log "info", "<- $modname$procname"; return 1 unless $@; unless ($@ =~ /(udp_sock|send|close)/){ XB_Log::log "warning", " ! $procname caught unknown exception". " $@"; } die "$modname$procname"; } # Description: # [CTL] Process XBone control refresh command # Arguments: # $cmd (ref) refresh command # Returns: # 1 on success # 0 on failure # Exceptions: # - sub ctl_refresh($){ my ($cmd) = @_; my $procname = "ctl_refresh"; XB_Log::log "info", "-> $modname$procname $cmd"; eval{ my ($k, $v); for my $app (@{$cmd->{command}{applist}}){ while(($k, $v) = each %{$app}){ if(exists $XB_Params::node_state{active_apps}{$k}{$v}){ my $now = time; $XB_Params::node_state{active_apps}{$k}{$v}{expire} = $now + $XB_Params::expire; my $timestr = localtime $now; XB_Log::log "debug2", " [$procname] $k $v refreshed \@ $timestr"; }else{ XB_Log::log "warning", " [$procname] refresh $k $v: app not found"; } } } }; XB_Log::log "info", "<- $modname$procname"; return 1 unless $@; XB_Log::log "warning", " ! $procname caught unknown exception: $@"; return 0; } 1;