### 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=){ 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;