### 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;
syntax highlighted by Code2HTML, v. 0.9.1