db2ns.in 3.42 KB
Newer Older
1
#!/usr/bin/perl -w
Leigh Stoller's avatar
Leigh Stoller committed
2 3 4

#
# Copyright (c) 2000-2002 University of Utah and the Flux Group.
5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
# 
# {{{EMULAB-LICENSE
# 
# This file is part of the Emulab network testbed software.
# 
# This file is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at
# your option) any later version.
# 
# This file is distributed in the hope that it will be useful, but WITHOUT
# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General Public
# License for more details.
# 
# You should have received a copy of the GNU Affero General Public License
# along with this file.  If not, see <http://www.gnu.org/licenses/>.
# 
# }}}
Leigh Stoller's avatar
Leigh Stoller committed
24 25
#

Leigh Stoller's avatar
Leigh Stoller committed
26
use English;
27 28 29 30 31 32 33 34

# This is a very simple program that convers the virt_* tables in the DB
# into a NS file.  Not the original NS file, but a NS file that, if parsed
# will create identical virt_* entries.  Well, almost identical.  The virtual
# ports get changed.

use lib "@prefix@/lib";
use exitonwarn;
35
use libdb;
36 37 38 39 40 41 42

if ($#ARGV != 1) {
    print STDERR "Syntax: $0 pid eid\n";
    exit(1);
}
($pid,$eid) = @ARGV;

43
#
Leigh Stoller's avatar
Leigh Stoller committed
44
# Make sure the experiment exists
45
#
Leigh Stoller's avatar
Leigh Stoller committed
46 47
if (!ExpState($pid,$eid)) {
    die "There is no experiment $eid in project $pid\n";
48 49 50
}

#
Leigh Stoller's avatar
Leigh Stoller committed
51
# Make sure they have access to the experiment
52
#
Leigh Stoller's avatar
Leigh Stoller committed
53 54 55
if (!TBAdmin($UID) &&
    !TBExptAccessCheck($UID, $pid, $eid, TB_EXPT_READINFO)) {
    die("*** You do not have permission to access this experiment!\n");
56 57
}

58 59 60
print "source tb_compat.tcl\n";
print "set ns [new Simulator]\n";

61
my $result = DBQueryFatal("select ips,osid,cmd_line,rpms,deltas,startupcmd," .
62 63
		     "tarfiles,vname,type,failureaction " .
		     "from virt_nodes where pid=\"$pid\" and eid=\"$eid\"");
64

65
while (($ips,$osid,$cmdline,$rpms,$deltas,$startupcmd,
66
	$tarfiles,$vname,$type,$failureaction) = $result->fetchrow_array) {
67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86
    print "set $vname [\$ns node]\n";
    foreach $ippair (split(" ",$ips)) {
	($port,$ip) = split(":",$ippair);
	$ips{"$vname:$port"} = $ip;
    }
    print "tb-set-node-os $vname $osid\n";
    print "tb-set-hardware $vname $type\n";
    print "tb-set-node-cmdline $vname \"$cmdline\"\n";
    if ($rpms ne "") {
	print "tb-set-node-rpms $vname $rpms\n";
    }
    if ($deltas ne "") {
	print "tb-set-node-deltas $vname $deltas\n";
    }
    print "tb-set-node-startup $vname \"$startupcmd\"\n";
    if ($tarfiles ne "") {
	print "tb-set-node-tarfiles $vname $tarfiles\n";
    }
    print "tb-set-node-failure-action $vname $failureaction\n";
}
87
$result->finish;
88

89
$result = DBQueryFatal("select vname,delay,bandwidth,lossrate,member" .
90 91
		     " from virt_lans where pid=\"$pid\" and eid=\"$eid\"");
%lans = ();
92
while (($vname,$delay,$bw,$loss,$member) = $result->fetchrow_array) {
93 94 95 96 97
    if (!defined($lans{$vname})) {
	$lans{$vname} = [];
    } 
    push(@{$lans{$vname}},[$member,$delay,$bw,$loss]);
}
98
$result->finish;
99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116
foreach $lan (keys(%lans)) {
    $raw = "";
    foreach $member (@{$lans{$lan}}) {
	@info = @$member;
	$nodeport = $info[0];
	$node = (split(":",$nodeport))[0];
	$raw .= "$node ";
    }
    print "set $lan [\$ns make-lan \"$raw\" 100Mb 0ms]\n";
    foreach $member (@{$lans{$lan}}) {
	($nodeport,$delay,$bw,$loss) = @$member;
	($node,$port) = split(":",$nodeport);
	print "tb-set-ip-lan $node $lan " . $ips{$nodeport} . "\n";
	print "tb-set-node-lan-params $node $lan $delay $bw $loss\n";
    }
}

print "\$ns run\n";
117
exit(0);