Commit 2202fc5a authored by Leigh Stoller's avatar Leigh Stoller

Make the new parser live on mini. New parser ssh'es over to ops to

do the actual parse. The parser now spits out XML instead of DB
queries, and the wrapper on boss converts that to DB insertions after
verification. There are some makefile changes as well to install the
new parser on ops via NFS, since otherwise the parser could
intolerably out of date on ops!
parent f9d065b7
......@@ -65,6 +65,7 @@ ops-install:
@$(MAKE) -C event control-install
install-mkdirs:
-mkdir -p $(INSTALL_TOPDIR)/opsdir
-mkdir -p $(INSTALL_TOPDIR)/locks
-mkdir -p $(INSTALL_TOPDIR)/log
-mkdir -p $(INSTALL_TOPDIR)/log/mysql
......
......@@ -1365,7 +1365,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
db/dbcheck db/interswitch db/dbboot db/schemacheck \
db/sitevarscheck \
db/grabron db/webnfree db/stategraph db/readycount \
db/idletimes db/idlemail db/webidlemail \
db/idletimes db/idlemail db/webidlemail db/xmlconvert \
discvr/GNUmakefile \
ipod/GNUmakefile \
lib/GNUmakefile lib/libtb/GNUmakefile \
......@@ -1394,7 +1394,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
tbsetup/startexp tbsetup/endexp tbsetup/webstartexp tbsetup/webendexp \
tbsetup/snmpit tbsetup/ns2ir/GNUmakefile \
tbsetup/ns2ir/parse.tcl tbsetup/ns2ir/tb_compat.tcl \
tbsetup/ns2ir/parse-ns \
tbsetup/ns2ir/parse-ns tbsetup/ns2ir/parse.proxy \
tbsetup/ns2ir/sim.tcl tbsetup/db2ns \
tbsetup/tbprerun tbsetup/tbswap tbsetup/tbend \
tbsetup/tbreport tbsetup/named_setup tbsetup/exports_setup \
......
......@@ -402,7 +402,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
db/dbcheck db/interswitch db/dbboot db/schemacheck \
db/sitevarscheck \
db/grabron db/webnfree db/stategraph db/readycount \
db/idletimes db/idlemail db/webidlemail \
db/idletimes db/idlemail db/webidlemail db/xmlconvert \
discvr/GNUmakefile \
ipod/GNUmakefile \
lib/GNUmakefile lib/libtb/GNUmakefile \
......@@ -431,7 +431,7 @@ outfiles="$outfiles Makeconf GNUmakefile \
tbsetup/startexp tbsetup/endexp tbsetup/webstartexp tbsetup/webendexp \
tbsetup/snmpit tbsetup/ns2ir/GNUmakefile \
tbsetup/ns2ir/parse.tcl tbsetup/ns2ir/tb_compat.tcl \
tbsetup/ns2ir/parse-ns \
tbsetup/ns2ir/parse-ns tbsetup/ns2ir/parse.proxy \
tbsetup/ns2ir/sim.tcl tbsetup/db2ns \
tbsetup/tbprerun tbsetup/tbswap tbsetup/tbend \
tbsetup/tbreport tbsetup/named_setup tbsetup/exports_setup \
......
......@@ -21,7 +21,7 @@ sub usage()
}
my $optlist = "x:vd";
my $fromxml = 0;
my $nowrite = 0;
my $impotent = 0;
my $debug = 0;
#
......@@ -56,14 +56,14 @@ my %virtual_tables = ("experiments" => undef,
# The experiment table is special. Only certain fields are allowed to
# be updated. Not sure what the right approach for this is.
#
my %experiment_fields = ("multiplex_factor" => 1,
forcelinkdelays => 1,
uselinkdelays => 1,
usewatunnels => 1,
uselatestwadata => 1,
wa_delay_solverweight => 1,
wa_bw_solverweight => 1,
wa_plr_solverweight => 1);
my %experiment_fields = ("multiplex_factor" => 1,
"forcelinkdelays" => 1,
"uselinkdelays" => 1,
"usewatunnels" => 1,
"uselatestwadata" => 1,
"wa_delay_solverweight" => 1,
"wa_bw_solverweight" => 1,
"wa_plr_solverweight" => 1);
#
# Turn off line buffering on output
......@@ -105,7 +105,7 @@ if (defined($options{"x"})) {
fatal("Bad data in argument: $xmlfile.");
}
if (defined($options{"n"})) {
$nowrite = 1;
$impotent = 1;
}
}
if (@ARGV != 2) {
......@@ -198,11 +198,15 @@ sub readXML($$$) {
if (! exists($virtual_tables{$tablename})) {
fatal("Unknown virtual table: $_");
}
# New table. Define a list.
if (defined($virtual_tables{$tablename})) {
fatal("Duplicate virtual table: $_");
#
# New table. Define a list. Note that the parser will spit
# out the table start/end tags multiple times, since the
# parser is written in such a way that its not possible to
# flatten it out. Thats okay.
#
if (! defined($virtual_tables{$tablename})) {
$virtual_tables{$tablename} = [];
}
$virtual_tables{$tablename} = [];
print "Starting new table: $tablename\n"
if ($debug);
......@@ -241,7 +245,7 @@ sub readXML($$$) {
#
if ($1 ne "pid" && $1 ne "eid") {
$row->{$1} = xmldecode($2);
print " Entering new element: $1/$row->{$1}\n"
print " Entering new element: $1: $row->{$1}\n"
if ($debug);
}
}
......@@ -286,49 +290,62 @@ sub readXML($$$) {
#
# Okay, thats all the checking we do! There is not much that can
# screw up the DB, by inserting rows into the allowed set of tables.
# screw up the DB just by inserting rows into the allowed set of
# virtual experiment tables, since we ignore the pid/eid in the xml.
#
# First the experiments table, which gets an update.
# First the experiments table, which gets an update statement, if there
# is anything to update.
#
my @setlist = ();
foreach my $key (keys(%experiments_table)) {
$val = $experiments_table{$key};
if ($val eq "NULL") {
push(@setlist, "$key=NULL");
if (scalar(keys(%experiments_table))) {
my @setlist = ();
foreach my $key (keys(%experiments_table)) {
my $val = $experiments_table{$key};
if ($val eq "NULL") {
push(@setlist, "$key=NULL");
}
else {
push(@setlist, "$key='$val'");
}
}
else {
push(@setlist, "$key='$val'");
}
my $query = "update experiments ".
"set " . join(",", @setlist) . " " .
"where eid='$eid' and pid='$pid'";
print "$query\n"
if ($debug);
DBQueryFatal($query)
if (!$impotent);
}
my $query = "update experiments ".
"set " . join(",", @setlist) . " " .
"where eid='$eid' and pid='$pid'";
print "$query\n"
if ($debug);
DBQueryFatal($query)
if (!$nowrite);
#
# Now all the other tables, which get inserts. Need to delete all the
# old info too.
#
foreach my $table (keys(%virtual_tables)) {
# Don't want to muck with this table! Done above.
next
if ($table eq "experiments");
# Delete always.
DBQueryFatal("delete from $table ".
"where eid='$eid' and pid='$pid'")
if (!$nowrite);
if (!$impotent);
next
if (!defined($virtual_tables{$table}));
next
if ($table eq "experiments");
foreach my $rowref (@{$virtual_tables{$table}}) {
my %rowhash = %{ $rowref };
my @fields = ("pid", "eid");
my @values = ("'$pid'", "'$eid'");
# If no actual rows, then skip. Might happen.
last
if (! scalar(keys(%rowhash)));
foreach my $key (keys(%rowhash)) {
$val = $rowhash{$key};
my $val = $rowhash{$key};
if ($val eq "NULL") {
push(@values, "NULL");
......@@ -344,7 +361,7 @@ sub readXML($$$) {
print "$query\n"
if ($debug);
DBQueryFatal($query)
if (!$nowrite);
if (!$impotent);
}
}
return 0;
......
......@@ -77,14 +77,20 @@ install: all script-install subdir-install
#
subdir-install:
@$(MAKE) -C checkpass install
ifneq ($(OURDOMAIN),emulab.net)
@$(MAKE) -C ns2ir install
endif
script-install: $(addprefix $(INSTALL_BINDIR)/, $(BIN_STUFF)) \
$(addprefix $(INSTALL_SBINDIR)/, $(SBIN_STUFF)) \
$(addprefix $(INSTALL_LIBDIR)/, $(LIB_STUFF)) \
$(addprefix $(INSTALL_LIBEXECDIR)/, $(LIBEXEC_STUFF))
$(addprefix $(INSTALL_LIBEXECDIR)/, $(LIBEXEC_STUFF)) \
$(addprefix $(INSTALL_DIR)/opsdir/lib/, libtestbed.pm)
post-install:
ifneq ($(OURDOMAIN),emulab.net)
@$(MAKE) -C ns2ir post-install
endif
chmod 775 $(INSTALL_BINDIR)
chmod 775 $(INSTALL_SBINDIR)
chmod 775 $(INSTALL_LIBDIR)
......@@ -138,6 +144,7 @@ control-install: $(addprefix $(INSTALL_SBINDIR)/, console_setup.proxy) \
$(addprefix $(INSTALL_SBINDIR)/, exports_setup.proxy) \
$(addprefix $(INSTALL_SBINDIR)/, sfskey_update.proxy) \
$(addprefix $(INSTALL_LIBDIR)/, libtestbed.pm)
@$(MAKE) -C ns2ir control-install
$(LINKS)
#
......@@ -164,4 +171,7 @@ subdir-distclean:
%: %.tcl
cp -p $< $@
$(INSTALL_DIR)/opsdir/lib/%: %
@echo "Installing $<"
-mkdir -p $(INSTALL_DIR)/opsdir/lib
$(INSTALL) $< $@
......@@ -33,7 +33,7 @@ use lib "@prefix@/lib";
use libdb;
use libtestbed;
my $parser = "$TB/libexec/ns2ir/parse-ns";
my $parser = "$TB/libexec/parse-ns";
my $mkexpdir = "$TB/libexec/mkexpdir";
my $startexp = "$TB/bin/startexp";
my $tbdata = "tbdata";
......
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# All rights reserved.
#
......@@ -14,21 +14,32 @@ SUBDIR = tbsetup/ns2ir
include $(OBJDIR)/Makeconf
LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \
LIB_STUFF = lanlink.tcl node.tcl sim.tcl tb_compat.tcl null.tcl \
nsobject.tcl traffic.tcl vtype.tcl parse.tcl program.tcl \
nsenode.tcl nstb_compat.tcl
LIBEXEC_STUFF = parse-ns
BOSSLIBEXEC = parse-ns
USERLIBEXEC = parse.proxy
#
# Force dependencies on the scripts so that they will be rerun through
# configure if the .in file is changed.
#
all: $(LIB_STUFF) $(LIBEXEC_STUFF)
all: $(LIB_STUFF) $(BOSSLIBEXEC) $(USERLIBEXEC)
include $(TESTBED_SRCDIR)/GNUmakerules
install: $(addprefix $(INSTALL_LIBDIR)/ns2ir/, $(LIB_STUFF)) \
$(addprefix $(INSTALL_LIBEXECDIR)/ns2ir/, $(LIBEXEC_STUFF))
install: control-install \
$(addprefix $(INSTALL_LIBEXECDIR)/, $(BOSSLIBEXEC)) \
$(addprefix $(INSTALL_DIR)/opsdir/lib/ns2ir/, $(LIB_STUFF)) \
$(addprefix $(INSTALL_DIR)/opsdir/libexec/ns2ir/, $(USERLIBEXEC))
control-install: $(addprefix $(INSTALL_LIBDIR)/ns2ir/, $(LIB_STUFF)) \
$(addprefix $(INSTALL_LIBEXECDIR)/ns2ir/, $(USERLIBEXEC))
post-install:
chmod 775 $(INSTALL_LIBEXECDIR)
chown root $(INSTALL_LIBEXECDIR)/parse-ns
chmod u+s $(INSTALL_LIBEXECDIR)/parse-ns
$(INSTALL_LIBDIR)/ns2ir/%: %
@echo "Installing $<"
......@@ -40,4 +51,14 @@ $(INSTALL_LIBEXECDIR)/ns2ir/%: %
-mkdir -p $(INSTALL_LIBEXECDIR)/ns2ir
$(INSTALL) $< $@
$(INSTALL_DIR)/opsdir/lib/ns2ir/%: %
@echo "Installing $<"
-mkdir -p $(INSTALL_DIR)/opsdir/lib/ns2ir
$(INSTALL) $< $@
$(INSTALL_DIR)/opsdir/libexec/ns2ir/%: %
@echo "Installing $<"
-mkdir -p $(INSTALL_DIR)/opsdir/libexec/ns2ir
$(INSTALL) $< $@
clean:
......@@ -384,7 +384,6 @@ LanLink instproc rename_node {old new} {
}
Link instproc updatedb {DB} {
$self next $DB
$self instvar toqueue
$self instvar fromqueue
$self instvar nodelist
......@@ -392,6 +391,19 @@ Link instproc updatedb {DB} {
$self instvar trivial_ok
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
$self instvar bandwidth
$self instvar rbandwidth
$self instvar delay
$self instvar rdelay
$self instvar loss
$self instvar rloss
$self instvar cost
$self instvar widearea
$self instvar uselinkdelay
$self instvar emulated
$self instvar nobwshaping
$self instvar useveth
$self instvar sim
foreach nodeport $nodelist {
set node [lindex $nodeport 0]
......@@ -435,17 +447,34 @@ Link instproc updatedb {DB} {
set droptail_ [$linkqueue set drop-tail_]
set nodeportraw [join $nodeport ":"]
sql exec $DB "update virt_lans set q_limit=$limit_, q_maxthresh=$maxthresh_, q_minthresh=$thresh_, q_weight=$q_weight_, q_linterm=$linterm_, q_qinbytes=${queue-in-bytes_}, q_bytes=$bytes_, q_meanpsize=$mean_pktsize_, q_wait=$wait_, q_setbit=$setbit_, q_droptail=$droptail_, q_red=$red_, q_gentle=$gentle_, trivial_ok=$trivial_ok where pid=\"$pid\" and eid=\"$eid\" and vname=\"$self\" and member=\"$nodeportraw\""
set fields [list "vname" "member" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "usevethiface" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok"]
set values [list $self $nodeportraw $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $useveth $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok]
$sim spitxml_data "virt_lans" $fields $values
}
}
Lan instproc updatedb {DB} {
$self next $DB
$self instvar nodelist
$self instvar linkq
$self instvar trivial_ok
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
$self instvar bandwidth
$self instvar rbandwidth
$self instvar delay
$self instvar rdelay
$self instvar loss
$self instvar rloss
$self instvar cost
$self instvar widearea
$self instvar uselinkdelay
$self instvar emulated
$self instvar nobwshaping
$self instvar useveth
$self instvar sim
foreach nodeport $nodelist {
set node [lindex $nodeport 0]
......@@ -490,31 +519,12 @@ Lan instproc updatedb {DB} {
set droptail_ [$linkqueue set drop-tail_]
set nodeportraw [join $nodeport ":"]
sql exec $DB "update virt_lans set q_limit=$limit_, q_maxthresh=$maxthresh_, q_minthresh=$thresh_, q_weight=$q_weight_, q_linterm=$linterm_, q_qinbytes=${queue-in-bytes_}, q_bytes=$bytes_, q_meanpsize=$mean_pktsize_, q_wait=$wait_, q_setbit=$setbit_, q_droptail=$droptail_, q_red=$red_, q_gentle=$gentle_, trivial_ok=$trivial_ok where pid=\"$pid\" and eid=\"$eid\" and vname=\"$self\" and member=\"$nodeportraw\""
}
}
# updatedb DB
# This adds a row to the virt_lans table.
LanLink instproc updatedb {DB} {
$self instvar nodelist
$self instvar bandwidth
$self instvar rbandwidth
$self instvar delay
$self instvar rdelay
$self instvar loss
$self instvar rloss
$self instvar cost
$self instvar widearea
$self instvar uselinkdelay
$self instvar emulated
$self instvar nobwshaping
$self instvar useveth
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
set fields [list "vname" "member" "delay" "rdelay" "bandwidth" "rbandwidth" "lossrate" "rlossrate" "cost" "widearea" "emulated" "uselinkdelay" "nobwshaping" "usevethiface" "q_limit" "q_maxthresh" "q_minthresh" "q_weight" "q_linterm" "q_qinbytes" "q_bytes" "q_meanpsize" "q_wait" "q_setbit" "q_droptail" "q_red" "q_gentle" "trivial_ok"]
set values [list $self $nodeportraw $delay($nodeport) $rdelay($nodeport) $bandwidth($nodeport) $rbandwidth($nodeport) $loss($nodeport) $rloss($nodeport) $cost($nodeport) $widearea $emulated $uselinkdelay $nobwshaping $useveth $limit_ $maxthresh_ $thresh_ $q_weight_ $linterm_ ${queue-in-bytes_} $bytes_ $mean_pktsize_ $wait_ $setbit_ $droptail_ $red_ $gentle_ $trivial_ok]
foreach nodeport $nodelist {
set nodeportraw [join $nodeport ":"]
sql exec $DB "insert into virt_lans (pid,eid,vname,member,delay,rdelay,bandwidth,rbandwidth,lossrate,rlossrate,cost,widearea,emulated,uselinkdelay,nobwshaping,usevethiface) values (\"$pid\",\"$eid\",\"$self\",\"$nodeportraw\",$delay($nodeport),$rdelay($nodeport),$bandwidth($nodeport),$rbandwidth($nodeport),$loss($nodeport),$rloss($nodeport),$cost($nodeport),$widearea,$emulated,$uselinkdelay,$nobwshaping,$useveth)"
$sim spitxml_data "virt_lans" $fields $values
}
}
......@@ -124,6 +124,7 @@ Node instproc updatedb {DB} {
$self instvar realtime
$self instvar isvirt
$self instvar virthost
var_import ::TBCOMPAT::default_osids
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
var_import ::GLOBALS::default_ip_routing_type
......@@ -132,12 +133,10 @@ Node instproc updatedb {DB} {
# If we haven't specified a osid so far then we should fill it
# with the id from the node_types table now.
if {$osid == {}} {
if {$virthost} {
set osid "FBSD-STD"
} else {
sql query $DB "select osid from node_types where type = \"$type\""
set osid [sql fetchrow $DB]
sql endquery $DB
if {$virthost == 0} {
if {[info exists default_osids($type)]} {
set osid $default_osids($type)
}
}
} else {
# Do not allow user to set os for virt nodes at this time.
......@@ -167,7 +166,7 @@ Node instproc updatedb {DB} {
$self add_routes_to_DB $DB
# Update the DB
sql exec $DB "insert into virt_nodes (pid,eid,vname,type,ips,osname,cmd_line,rpms,deltas,startupcmd,tarfiles,failureaction,routertype,fixed) values (\"$pid\",\"$eid\",\"$self\",\"$type\",\"$ipraw\",\"$osid\",\"$cmdline\",\"$rpms\",\"$deltas\",\"$startup\",\"$tarfiles\",\"$failureaction\",\"$default_ip_routing_type\",\"$fixed\")";
$sim spitxml_data "virt_nodes" [list "vname" "type" "ips" "osname" "cmd_line" "rpms" "deltas" "startupcmd" "tarfiles" "failureaction" "routertype" "fixed" ] [list $self $type $ipraw $osid $cmdline $rpms $deltas $startup $tarfiles $failureaction $default_ip_routing_type $fixed ]
}
# add_lanlink lanlink
......@@ -353,7 +352,6 @@ Node instproc add_routes_to_DB {DB} {
return
}
}
sql exec $DB "insert into virt_routes (pid,eid,vname,dst,nexthop,dst_type) values ('$pid','$eid','$self','$dstip','$hopip','$type')";
$sim spitxml_data "virt_routes" [list "vname" "dst" "nexthop" "dst_type" ] [list $self $dstip $hopip $type ]
}
}
This diff is collapsed.
#!/usr/bin/perl -w
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# All rights reserved.
#
use English;
use Getopt::Std;
use BSD::Resource;
use POSIX qw(:signal_h);
#
# Simply a wrapper for the parser. Passes on its arguments to parse.tcl,
# which spits out some stuff, which the caller reads back. Typically,
# this is via ssh from boss, since we want to run the parser on ops.
# The input to this script (on stdin) is the NS file supplied by the user,
# prepended with some hand crafted TCL code to set up the initial state
# of the parser (DB state the parser needs in order to run).
#
# The first argument option is the user to run this script as, since we
# gets invoked by a root ssh from boss. This option is not passed onto
# the parser of course!
#
# When run in "impotent" mode, there is no output, just an exit code.
#
sub usage()
{
print STDOUT
"Usage: parse.proxy -u user [args ...]\n".
"Where options and arguments are those required by parse.tcl\n";
exit(-1);
}
#
# Configure variables
#
my $TB = "@prefix@";
my $TBOPS = "@TBOPSEMAIL@";
my $TESTMODE = @TESTMODE@;
my $parser = "$TB/lib/ns2ir/parse.tcl";
# Locals
my $tempdir = "/tmp/parse-$$";
my $nsfile = "$$.ns";
#
# Turn off line buffering on output
#
$| = 1;
#
# Untaint the path
#
$ENV{'PATH'} = "/bin:/usr/bin:/sbin:/usr/sbin";
delete @ENV{'IFS', 'CDPATH', 'ENV', 'BASH_ENV'};
#
# Testbed Support libraries
#
use lib "@prefix@/lib";
use libtestbed;
#
# First option has to be the -u option, the user to run this script as.
# In testmode, we are not run as root, so run as the current user, and
# in the current directory (not invoked with ssh in testmode).
#
if (! $TESTMODE) {
if ($UID != 0) {
die("*** $0:\n".
" Must be root to run this script!");
}
if ($ARGV[0] ne "-u") {
die("*** $0:\n".
" Improper first argument. Must be the user name!\n");
}
my $user = $ARGV[1];
shift(@ARGV);
shift(@ARGV);
(undef,undef,$unix_uid) = getpwnam($user) or
die("*** $0:\n".
" No such user $user\n");
#
# Need the entire group list for the user, cause of subgroups, and
# cause thats the correct thing to do. Too bad perl does not have a
# getgrouplist function like the C library.
#
my $glist = `id -G $user`;
if ($glist =~ /^([\d ]*)$/) {
$glist = $1;
}
else {
die("*** $0:\n".
" Unexpected results from 'id -G $user': $glist\n");
}
# Need to split off the first group and create a proper list for $GUID.
my @gglist = split(" ", $glist);
my $unix_gid = $gglist[0];
$glist = "$unix_gid $glist";
# Flip to user and never go back!
$GID = $unix_gid;
$EGID = $glist;
$EUID = $UID = $unix_uid;
$ENV{'USER'} = $user;
$ENV{'LOGNAME'} = $user;
#
# Create the tempdir and chmod it to keep people out.
#
if (! mkdir($tempdir, 0750)) {
die("Could not mkdir $tempdir: $!\n");
}
if (! chmod(0750, $tempdir)) {
die("Could not chmod $tempdir to 0750: $!\n");
}
if (! chdir($tempdir)) {
die("Could not chdir to $tempdir: $!\n");
}
}
#
# Take our input and write it to the temp file.
#
open(TMP, ">$nsfile") ||
fatal("Couldn't open $nsfile\n");
while (<STDIN>) {
print TMP $_;
}
close(TMP);
chmod(0644, $nsfile);
#
# Fork a child process to run the parser in.
#
my $pid = fork();
if (!defined($pid)) {
die("*** $0:\n".
" Could not fork a new process!");
}
#
# Child runs the parser, niced down, and then exits.
#
if (! $pid) {
# Set the CPU limit for us.
setrlimit(RLIMIT_CPU, 60, 60);
# Give parent a chance to react.
sleep(1);
system("nice $parser @ARGV $nsfile");
exit($? >> 8);
}
#
# Parent waits.
#
waitpid($pid, 0);
#
# If the child was KILLed, then it overran its time limit.
# Send email. Otherwise, exit with result of child.
#
if (($? >> 8) == SIGKILL) {
my $msg = "Parser Exceeded CPU Limit";
SENDMAIL($TBOPS, "Parser Exceeded CPU Limit", $msg,
undef, undef, ($nsfile));
print STDERR "$msg\n";
if (-d $tempdir) {
system("/bin/rm -r $tempdir");
}
exit(15);
}
if (-d $tempdir) {
system("/bin/rm -r $tempdir");
}
exit($? >> 8);
......@@ -21,8 +21,6 @@
# without updating the database.
######################################################################
package require sql
# Initial Procedures
###
......@@ -84,7 +82,6 @@ proc perror {msg} {
###
proc punsup {msg} {
var_import ::GLOBALS::verbose
var_import ::GLOBALS::WARN_FILE
var_import ::GLOBALS::simulated
# If this was a true error in specifying
......@@ -93,8 +90,6 @@ proc punsup {msg} {
if {$simulated == 0 && $verbose == 1} {
puts stderr "*** WARNING: Unsupported NS Statement!"
puts stderr " $msg"
puts $WARN_FILE "*** WARNING: Unsupported NS Statement!"
puts $WARN_FILE " $msg"
}
}
......@@ -189,9 +184,6 @@ namespace eval GLOBALS {
# classes.
variable new_counter 0
# This will hold the handle for the database connection
variable DB {}
# These are going to be default values within the NS file.
variable default_ip_routing_type "none"
......@@ -215,9 +207,6 @@ namespace eval GLOBALS {
variable wa_bw_solverweight 7
variable wa_plr_solverweight 500
# This is the file handler for the warnings file
variable WARN_FILE [open "$eid.warnings" w]
# This distinguishes whether the script that
# is being parsed should go into a NSE simulation or not
variable simulated 0
......@@ -226,25 +215,6 @@ namespace eval GLOBALS {
variable enforce_user_restrictions 1
}
# Connect to the DB
set GLOBALS::DB [sql conn]
sql selectdb ${GLOBALS::DB} @TBDBNAME@
namespace eval GLOBALS {
# A mapping of event objects.
variable objtypes
sql query $DB \
"select idx,type from event_objecttypes"
while {[set row [sql fetchrow $DB]] != ""} {
set idx [lindex $row 0]
set type [lindex $row 1]
set objtypes($type) $idx
}
sql endquery $DB
}
# Load all our classes
source ${GLOBALS::libdir}/nsobject.tcl
source ${GLOBALS::libdir}/sim.tcl
......@@ -437,9 +407,4 @@ if { ${GLOBALS::errors} != 1 } {
}
# Clean up
sql disconnect ${GLOBALS::DB}
close ${GLOBALS::WARN_FILE}
exit ${GLOBALS::errors}
# -*- tcl -*-
#
# EMULAB-COPYRIGHT
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
# Copyright (c) 2000-2003 University of Utah and the Flux Group.
# All rights reserved.
#
......@@ -42,9 +42,10 @@ Program instproc rename {old new} {
Program instproc updatedb {DB} {
var_import ::GLOBALS::pid
var_import ::GLOBALS::eid
var_import ::GLOBALS::objtypes
var_import ::TBCOMPAT::objtypes
$self instvar node
$self instvar command
$self instvar sim
if {$node == {}} {
perror "\[updatedb] $self has no node."
......@@ -62,6 +63,6 @@ Program instproc updatedb {DB} {
set progvnode [$node set nsenode]
}
sql exec $DB "insert into virt_agents (pid,eid,vnode,vname,objecttype) values ('$pid','$eid','$progvnode','$self','$objtypes(PROGRAM)')";
$sim spitxml_data "virt_agents" [list "vnode" "vname" "objecttype" ]