### 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_AppCmds.pm,v $
#
# $Revision: 1.11 $
# $Author: pingali $
# $Date: 2005/03/31 07:03:53 $
# $State: Exp $
# ----------------------------------------------------------------------------
#
# Primary Author: Yu-Shun Wang
#
# Modules for XBone Application Deployment:
#
# (1) XB_AppScript.pm:
# - get_script: [GUI] download application scripts
# - get_app_info: [OM] extract application info from the script
# (2) XB_AppCmds.pm:
# - grep_script: [RD] extract the script from commands & save it
# - grep_values: [RD] extract keyword-values from overlay database
# - patch_script: [RD] replace keywords in the script with values
# - exec_script: [RD] execute the script with given arguments
#
# Key actions about application deployment & cleanup:
#
# (1) Create Overlay
# - XB_Commands::XB_CreateOverlay
# -> XB_Commands::XB_dispatch_on_nodecommand
# -> XB_Commands::XB_ncmd_appstart => [App]: conf & run
# (2) Delete Overlay & Delete All Overlays
# - XB_Commands::XB_DestroyOverlay
# -> XB_Commands::XB_dispatch_on_nodecommand
# -> XB_Commands::XB_ncmd_overlay
# -> XB_Commands::XB_delete_overlays (KillAll only)
# -> XB_Node_DB::XB_overlay_delete => [App]: kill & cleanup
# (3) Crash Recovery
# - XB_Node_DB::XB_read_state
# -> XB_Node_DB::XB_restore_state
# -> XB_Node_DB::XB_restore_overlay => [App]: (restart) run
# -----------------------------------------------------------------------------
package XB_AppCmds;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(grep_script);
@EXPORT_OK = qw ();
use strict;
use sigtrap;
use Data::Dumper;
use XB_Params;
use XB_Log;
#==============================================================================
# Description:
# Grep and save the application script from the received command.
# Arguments:
# command
# Returns:
# new command = (old command =~ s/script_part/AppScript=/path/to/script/)
# Exceptions:
# "XB_AppCmds::grep_script" on error, nothing to clean up by caller
# Side Effects:
# A script file will be saved in $XB_Params::APP_RUN/$app_name-$ovl_name.
sub grep_script($)
{
my $cmd = shift;
my $new_cmd = "";
my ($ovl_name, $vnode, $app_name, $app_script, @cmd_array);
XB_Log::log "info", "-> XB_AppCmds::grep_script cmd";
# XB_Log::log "debug4",
# "#-- XB_AppCmds::grep_script [before extraction] -----------------------\n".
# "$cmd".
# "#----------------------------------------------------------------------";
# # cmd w/ script is very loooong ...
eval{
if ($cmd =~ /\bXboneOverlay\b\s*\bName=(\S+)\b/){ $ovl_name = $1; }
else{
XB_Log::log "err", " Missing overlay name" and die "field";
}
if ($cmd =~ /\bAppName=(\S+)\b/){ $app_name = $1; }
else {
XB_Log::log "err", " Missing application name" and die "field";
}
if ($cmd =~ /\bVNODE=(\S+)/){ $vnode = $1; }
else {
XB_Log::log "err", " Missing virtual node name" and die "field";
}
if (! -d $XB_Params::APP_RUN)
{
my @md = ("mkdir", "-p", "-m", "0755", "$XB_Params::APP_RUN");
my $rc = 0xff & system (@md);
($rc == 0) or
XB_Log::log "err", "mkdir $XB_Params::APP_RUN failed: $!";
}
$app_script = "$XB_Params::APP_RUN/$app_name-$vnode-$ovl_name";
if(-f $app_script){
my @rm = ("rm", "-f", "$app_script");
my $rc = 0xff & system (@rm);
($rc == 0) or
XB_Log::log "err", " rm -f $app_script failed: $!"
and die "rm";
}
open SC, ">$app_script" or
XB_Log::log "err", " open >$app_script failed: $!" and die "open";
@cmd_array = split /\n/, $cmd;
my $started = 0;
my $script_body;
while (my $line = shift @cmd_array){
if($line =~ s/\bScriptStart\b/AppScript=$app_script/){
$new_cmd .= "$line\n";
$started=1;
while (1){
my $body = shift @cmd_array;
if($body =~ /XboneEOC/){
# Command ends before script, something is wrong!
XB_Log::log "err", " Xbone command ends before script!" and
die "eoc";
}elsif($body !~ /\bScriptEnd\b/){
$script_body .= "$body\n";
}else{
print SC $script_body;
$started = 2;
last;
}
}
}else{
$new_cmd .= "$line\n";
}
}
close SC or XB_Log::log "err", " close $app_script failed: $!"
and die "close";
chmod 0755, "$app_script";
if($started == 0) {
XB_Log::log "err", " Application Script Missing" and die "script";
}elsif($started == 1){
XB_Log::log "err", " Application Script Incomplete" and die "script";
}
};
XB_Log::log "info", "<- XB_AppCmds::grep_script cmd";
XB_Log::log "debug5",
"#-- XB_AppCmds::grep_script [after extraction] ------------------------\n".
"$new_cmd".
"-----------------------------------------------------------------------";
return $new_cmd unless $@; #success if no exception
unless($@ =~ /^(field|open|close|script|eoc)/){
XB_Log::log "warning",
"XB_AppCmds::grep_script caught unexpected exception $@";
}
die "XB_AppCmds::grep_script";
}
#==============================================================================
# Description:
# Grep the values of known keywords from the overlay command.
# Arguments:
# ref(command hash), ref(overlay hash), ref(keyword list)
# Returns:
# hash: (Name => Value)
# Exceptions:
# "XB_AppCmds::grep_value" on error, nothing to clean up by caller
# Notes:
# ovlhref is necessary if we need the interface names (not yet included).
sub grep_value($$$)
{
my ($mhref, $ovlhref, $keywords) = @_;
#my ($REALHOST, $OVLHOST, $OVLNAME, $OVLSUFFIX, $REALIP, $IPLIST, $IP1);
#my ($APPNAME, $APPSCRIPT);
my %value;
XB_Log::log "info", "-> XB_AppCmds::grep_value @_";
eval{
if(defined $mhref->{'XboneNodes'}){
my @nodes = @{$mhref->{'XboneNodes'}};
if(defined ${$nodes[0]}{'ID'}){
$value{"REALHOST"} = ${$nodes[0]}{'ID'};
$value{"OVLHOST"} = ${$nodes[0]}{'VNODE'};
$value{"OVLHOST"} =~ s/^([a-zA-Z0-9_]+)\.\S+/$1/;
}else{
XB_Log::log "err", " - missing field: XboneNodes->ID"
and die "missing";
}
if(defined ${$nodes[0]}{'IPaddr'}){
$value{"REALIP"} = ${$nodes[0]}{'IPaddr'};
}else{
XB_Log::log "err", " - missing field: XboneNodes->IPaddr"
and die "missing";
}
}else{
XB_Log::log "err", " - missing field: XboneNodes" and die "missing";
}
if(defined $mhref->{'XboneOverlay'}{'Name'}){
if($mhref->{'XboneOverlay'}{'Name'} =~ /^([a-zA-Z0-9_-]+)\.(\S+)/){
$value{"OVLNAME"} = $1;
$value{"OVLSUFFIX"} = $2;
$value{"OVLHOST"} .= ".". $value{"OVLNAME"}. ".". $value{"OVLSUFFIX"};
}else{
XB_Log::log "err",
" - unknown format $mhref->{'XboneOverlay'}{'Name'}"
and die "format";
}
}else{
XB_Log::log "err", " - missing field: XboneOverlay->Name"
and die "missing";
}
my $vnode = $mhref->{'XboneNodes'}[0]{'VNODE'};
if(defined $ovlhref->{'Tunnel_Tags'}{$vnode}){
$value{"IPLIST"} = "";
my @tunnels = @{$ovlhref->{'Tunnel_Tags'}{$vnode}};
for (my $i=1; $i <= (@tunnels - 1); $i+=2){
my $tun = $tunnels[$i];
$tun = (split(/\|/, $tun))[1];
$value{"IPLIST"} .= "$tun, ";
}
$value{"IPLIST"} =~ s/^(.*)\,\s+$/$1/;
$value{"IP1"} = $tunnels[1];
$value{"IP1"} = (split(/\|/, $value{"IP1"}))[1];
}else{
XB_Log::log "err", " - missing field: ovlhref->Tunnel_Tags"
and die "missing";
}
if(defined $mhref->{'XboneApplication'}{'AppName'}){
$value{"APPNAME"} = $mhref->{'XboneApplication'}{'AppName'};
}else{
XB_Log::log "err", " - missing field: mhref->XboneApplication->AppName"
and die "missing";
}
if(defined $mhref->{'XboneApplication'}{'AppScript'}){
$value{"APPSCRIPT"} = $mhref->{'XboneApplication'}{'AppScript'};
}else{
XB_Log::log "err", " - missing field: mhref->XboneApplication->".
"AppScript" and die "missing";
}
foreach my $k (@$keywords){
unless(defined $value{$k}){
XB_Log::log "err", " - unknown keyword $k" and die "keyword";
}
}
};
XB_Log::log "info", "<- XB_AppCmds::grep_value";
unless($@){
my $dumpmsg = Dumper(\%value);
XB_Log::log "debug5", "[keyword->value]\n$dumpmsg";
return %value;
}
unless($@ =~ /^(missing|format|keyword)/){
XB_Log::log "warning",
"XB_AppCmds::grep_value caught unexpected exception $@";
}
die "XB_AppCmds::grep_value";
}
#==============================================================================
# Description:
# Replace the keywords in the script with values.
# Arguments:
# ref(value hash)
# Returns:
# 1 on success
# Exceptions:
# "XB_AppCmds::patch_script" on error, nothing to clean up by caller
# Note:
# Lines start with "#" will NOT be patched.
sub patch_script($$)
{
my ($keyhref, $script) = @_;
XB_Log::log "info", "-> XB_AppCmds::patch_script @_";
eval{
rename $script, $script.".ORIG" or
XB_Log::log "err", " rename $script to $script.ORIG failed: $!" and
die "rename";
open SC, ">$script" or
XB_Log::log "err", " open $script failed: $!" and die "open";
open OSC, "$script.ORIG" or
XB_Log::log "err", " open $script.ORIG failed: $!" and die "open";
while(my $line=<OSC>){
unless($line =~ /^\s*\#/){ # ignore comment lines
foreach my $k (keys %$keyhref){
$line =~ s/$k/${$keyhref}{$k}/g;
}
}
print SC $line;
}
close SC or
XB_Log::log "err", " close $script failed: $!" and die "close";
close OSC or
XB_Log::log "err", " close $script.ORIG failed: $!" and die "close";
chmod 0755, "$script";
};
XB_Log::log "info", "<- XB_AppCmds::patch_script";
return 1 unless $@;
unless ($@ =~ /^(rename|open|close)/){
XB_Log::log "warning",
"XB_AppCmds::patch_script caught unexpected exception: $@";
}
die "XB_AppCmds::patch_script";
}
#==============================================================================
# Description:
# Run the script with given parameters and (not yet) UID.
# Arguments:
# script, ref(@args) , uid
# Returns:
# 0 on success
# Exceptions:
# "XB_AppCmds::patch_script" on error, nothing to clean up by caller
# Note:
# - Setuid part is not implemented yet.
# - Should tie the setuid part with XBone ACL.
sub exec_script($$;$)
{
my ($script, $args, $uid) = @_;
my ($result);
XB_Log::log "info", "-> XB_AppCmds::exec_script @_";
eval{
unless (-x $script){
XB_Log::log "err", " $script not executable" and
die "x";
}
my @cmd = ($script, @$args);
my $cmdstr = "";
for my $c (@cmd){ $cmdstr .= "$c "; }
$result = system (@cmd);
unless ($result == 0){
XB_Log::log "err", " \"$cmdstr\" returns $result" and die "system";
}
};
XB_Log::log "info", "<- XB_AppCmds::exec_script";
return 0 unless $@;
unless ($@ =~ /^(x|system)/){
XB_Log::log "warning",
"XB_AppCmds::exec_script caught unexpected exception: $@";
}
die "XB_AppCmds::exec_script";
}
1;
syntax highlighted by Code2HTML, v. 0.9.1