Commit 4b07b9df authored by Christopher Alfeld's avatar Christopher Alfeld

This is the multiple links update.

Links can now be named:

set link1 [$ns duplex-link $node0 $node1 100Mb 100ms DropTail]

tb-set-link-loss can now either be

tb-set-link-loss $node0 $node1 0.05

OR

tb-set-link-loss $node0 $link1 0.05

There is a new command, tb-set-ip-link:

tb-set-ip-link $node0 $link0 192.0.0.4

and tb-set-ip-lan:

tb-set-ip-lan $node $mylan 192.0.1.2

--

WARNING: We are no longer backwards compatible with the old tb command
syntax.  The old syntax does not support any of the new changes and will
break when #TB set-lan-loss or #TB set-ip-interface is used.
parent b68577da
......@@ -152,27 +152,53 @@ while (<TBCMD>) {
last SWITCH1;
};
/^tb-set-ip-interface$/ && do {
# tb-set-ip-interface <node> <dst> <ip>
push(@ERRORS,"tb-set-ip-interface should have been converted to tb-set-ip-link. Check for newest version of tb_compat.tcl");
last SWITCH1;
};
/^tb-set-ip-link$/ && do {
# tb-set-ip-link <node> <link> <ip>
if ($#line != 3) {
push(@ERRORS,"Syntax: tb-set-ip-link node link ip\n");
last SWITCH1;
}
($node,$link,$ip) = @line[1..3];
if (! defined($vnodemap{$node})) {
push(@ERRORS,"$node is not a valid node.\n");
last SWITCH1;
}
if (! defined($links{$link})) {
push(@ERRORS,"$link is not a valid link.\n");
last SWITCH1;
}
if (! ($ip =~ /^([0-9]{1,3}\.){3,3}[0-9]{1,3}$/)) {
push(@ERRORS,"$ip is not a valid ip address.\n");
last SWITCH1;
}
$IP{"$node:$link"} = $ip;
last SWITCH1;
};
/^tb-set-ip-lan$/ && do {
# tb-set-ip-lan <node> <lan> <ip>
if ($#line != 3) {
push(@ERRORS,"Syntax: tb-set-ip-interface node dst ip\n");
push(@ERRORS,"Syntax: tb-set-ip-lan node lan ip\n");
last SWITCH1;
}
($node,$dst,$ip) = @line[1..3];
($node,$lan,$ip) = @line[1..3];
if (! defined($vnodemap{$node})) {
push(@ERRORS,"$node is not a valid node.\n");
last SWITCH1;
}
if (! defined($vnodemap{$dst})) {
push(@ERRORS,"$dst is not a valid node.\n");
if (! defined($lans{$lan})) {
push(@ERRORS,"$lan is not a valid lan.\n");
last SWITCH1;
}
if (! ($ip =~ /^([0-9]{1,3}\.){3,3}[0-9]{1,3}$/)) {
push(@ERRORS,"$ip is not a valid ip address.\n");
last SWITCH1;
}
$IP{"$node:$dst"} = $ip;
$IPLAN{"$node:$lan"} = $ip;
last SWITCH1;
}
};
}
}
......@@ -283,22 +309,22 @@ foreach $link (keys(%links)) {
next;
}
# Look for assigned ip
if (defined($IP{"$A:$B"})) {
printdb "Defined link IP " . $IP{"$A:$B"} . "\n";
if (defined($IP{"$A:$link"})) {
printdb "Defined link IP " . $IP{"$A:$link"} . "\n";
if (&islan($B)) {
$lansubnet{$B} = &get_subnet($IP{"$A:$B"});
$lansubnet{$B} = &get_subnet($IP{"$A:$link"});
printdb "lansubnet{$B} = $lansubnet{$B}\n";
}
$ip_section .= "$A $B $IP{$A . ':' . $B}\n";
printdb "ip_section .= \"$A $B " . $IP{"$A:$B"} . "\n";
$ip_section .= "$A $B $IP{$A . ':' . $link}\n";
printdb "ip_section .= \"$A $B " . $IP{"$A:$link"} . "\n";
push(@ip_mac_section,
[&intersect($MACTABLE{$A},&get_macs($link)),$IP{"$A:$B"}]);
printdb "ip_mac_section <- [" . join(",",&intersect($MACTABLE{$A},&get_macs($link))) . "," . $IP{"$A:$B"} . "]\n";
$ips_assigned{$IP{"$A:$B"}} = 1;
[&intersect($MACTABLE{$A},&get_macs($link)),$IP{"$A:$link"}]);
printdb "ip_mac_section <- [" . join(",",&intersect($MACTABLE{$A},&get_macs($link))) . "," . $IP{"$A:$link"} . "]\n";
$ips_assigned{$IP{"$A:$link"}} = 1;
if (!defined($ips_node{$A})) {
$ips_node{$A} = [];
}
push(@{$ips_node{$A}},$IP{"$A:$B"});
push(@{$ips_node{$A}},$IP{"$A:$link"});
} elsif (defined($IP{$A})) {
printdb "Node IP address $IP{$A}\n";
# node-wide IP address
......@@ -341,14 +367,14 @@ foreach $lan (keys(%lans)) {
@nodes = @{$lans{$lan}[1]};
foreach $node (@nodes) {
printdb "Looking at $node\n";
if (defined($IP{"$node:$lan"}) ||
defined($IP{"$lan:$node"})) {
if (defined($IP{"$node:$lan"})) {
$ip = $IP{"$node:$lan"};
$ips_assigned{$IP{"$node:$lan"}} = 1;
if (defined($IPLAN{"$node:$lan"}) ||
defined($IPLAN{"$lan:$node"})) {
if (defined($IPLAN{"$node:$lan"})) {
$ip = $IPLAN{"$node:$lan"};
$ips_assigned{$ip} = 1;
} else {
$ip = $IP{"$lan:$node"};
$ips_assigned{$IP{"$lan:$node"}} = 1;
$ip = $IPLAN{"$lan:$node"};
$ips_assigned{$ip} = 1;
}
printdb "Found link IP $ip\n";
$ip_section .= "$node $lan $ip\n";
......@@ -448,8 +474,8 @@ foreach $left (keys(%to_assign)) {
push(@{$ips_node{$node}},$ipA);
push(@{$ips_node{$dst}},$ipB);
} else {
if (defined($IP{"$dst:$node"})) {
$subnet = &get_subnet($IP{"$dst:$node"});
if (defined($IP{"$dst:$left"})) {
$subnet = &get_subnet($IP{"$dst:$left"});
} elsif (defined($IP{$dst})) {
$subnet = &get_subnet($IP{$dst});
} else {
......
......@@ -6,25 +6,25 @@ Class link
link instproc print {file} {
global nodeid_map prefix lanlist
if {[info exists nodeid_map([$self set src])]} {
set srcname $nodeid_map([$self set src])
real_set srcname $nodeid_map([$self set src])
} else {
set srcname [$self set src]
real_set srcname [$self set src]
}
if {[info exists nodeid_map([$self set dst])]} {
set dstname $nodeid_map([$self set dst])
real_set dstname $nodeid_map([$self set dst])
} else {
set dstname [$self set dst]
real_set dstname [$self set dst]
}
if {[lsearch $lanlist [$self set src]] != -1} {
set srcname $prefix-$srcname
real_set srcname $prefix-$srcname
}
if {[lsearch $lanlist [$self set dst]] != -1} {
set dstname $prefix-$dstname
real_set dstname $prefix-$dstname
}
if {[info exists nodeid_map(l[$self set id])]} {
set linkname $nodeid_map(l[$self set id])
real_set linkname $nodeid_map(l[$self set id])
} else {
set linkname "l[$self set id]"
real_set linkname "l[$self set id]"
}
puts $file "$prefix-$linkname $srcname [$self set srcport] $dstname [$self set dstport] [$self set bw] [$self set bw] [$self set delay] [$self set delay]"
}
......
......@@ -72,7 +72,7 @@ if ($@) {
# Shove it in a membership array
foreach (split("\n",$raw)) {
split;
$links{"$_[1]:$_[3]"} = 1;
$links{"$_[0]"} = [$_[1],$_[2]]
}
# Read in possible hardware types - we add shark_shelf manually
......@@ -111,32 +111,22 @@ while (<TBCMD>) {
# hwtype(node) = type
$hwtype{$line[1]} = $line[2];
} elsif ($line[0] eq "tb-set-link-loss") {
if ($#line != 3) {
push(@ERRORS,"Syntax: tb-set-link-loss src dst loss_rate");
next;
}
if ((! defined($nodes{$line[1]})) &&
(! defined($lans{$line[1]}))) {
push(@ERRORS,"$line[1] is not a valid node.");
next;
}
if ((! defined($nodes{$line[2]})) &&
(! defined($lans{$line[2]}))) {
push(@ERRORS,"$line[2] is not a valid node.");
if ($#line != 2) {
push(@ERRORS,"Syntax: tb-set-link-loss link loss_rate");
next;
}
if (! defined($links{"$line[1]:$line[2]"})) {
push(@ERRORS,"No link between $line[1] and $line[2]");
if (! defined($links{$line[1]})) {
push(@ERRORS,"$line[1] is not a valid link.");
next;
}
if ( ((! ($line[3] =~ /^[0-9]+(\.[0-9]+)?$/)) &&
(! ($line[3] =~ /^\.[0-9]+$/))) ||
($line[3] < 0) || ($line[3] > 1)) {
push(@ERRORS,"$line[3] not between 0.0 and 1.0");
if ( ((! ($line[2] =~ /^[0-9]+(\.[0-9]+)?$/)) &&
(! ($line[2] =~ /^\.[0-9]+$/))) ||
($line[2] < 0) || ($line[2] > 1)) {
push(@ERRORS,"$line[2] not between 0.0 and 1.0");
next;
}
# linkloss(src:dst) = loss
$linkloss{"$line[1]:$line[2]"} = $line[4];
$linkloss{$line[1]} = $line[2];
} elsif ($line[1] eq "tb-set-lan-loss") {
if ($#line != 2) {
push(@ERRORS,"Syntax: tb-set-lan-loss lan loss_rate");
......@@ -187,10 +177,9 @@ if ($@) {
@newlinks = ();
foreach (@links) {
@info = split;
$src = $info[1];
$dst = $info[3];
if (defined($linkloss{$src . ":" . $dst})) {
push(@newlinks,"$_ " . $linkloss{$src . ":" . $dst});
$link = $info[0];
if (defined($linkloss{$link})) {
push(@newlinks,"$_ " . $linkloss{$link});
} else {
push(@newlinks,"$_ 0.0");
}
......
......@@ -35,7 +35,7 @@
# SUCH DAMAGE.
#
# @(#) $Header: /home/cvs_mirrors/cvs-public.flux.utah.edu/CVS/testbed/tbsetup/ns2ir/Attic/sim.tcl,v 1.6 2001-03-14 19:37:37 calfeld Exp $
# @(#) $Header: /home/cvs_mirrors/cvs-public.flux.utah.edu/CVS/testbed/tbsetup/ns2ir/Attic/sim.tcl,v 1.7 2001-03-14 21:06:40 calfeld Exp $
#
......@@ -252,6 +252,7 @@ Simulator instproc duplex-link { n1 n2 bw delay type args } {
global linkID
global linkslist
global nodeID
global linkmap
# if there are delay or bandwidth restrictions, add a delay node
# and link to it
......@@ -279,6 +280,8 @@ Simulator instproc duplex-link { n1 n2 bw delay type args } {
incr linkID
lappend linkslist $currLink
lappend linkmap($n1:$n2) $currLink
lappend linkmap($n2:$n1) $currLink
return $currLink
}
......
......@@ -13,7 +13,29 @@ proc tb-set-ip {node ip} {
}
proc tb-set-ip-interface {src dst ip} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-ip-interface $nodeid_map($src) $nodeid_map($dst) $ip"
global linkmap prefix lanlist
if {[info exists linkmap($src:$dst)]} {
if {[info exists nodeid_map($linkmap($src:$dst))]} {
real_set linkname $nodeid_map($linkmap($src:$dst))
} else {
real_set linkname $linkmap($src:$dst)
}
puts $TBCMD "tb-set-ip-link $nodeid_map($src) $prefix-$linkname $ip"
} elseif {([lsearch $lanlist $dst] != -1)} {
tb-set-ip-lan $src $dst $ip
} else {
print stderr "No link exists between $src and $dst."
exit 1
}
}
proc tb-set-ip-lan {src lan ip} {
global TBCMD nodeid_map
global prefix
puts $TBCMD "tb-set-ip-lan $nodeid_map($src) $prefix-$nodeid_map($lan) $ip"
}
proc tb-set-ip-link {src link ip} {
global TBCMD nodeid_map prefix
puts $TBCMD "tb-set-ip-link $nodeid_map($src) $prefix-$nodeid_map($link) $ip"
}
proc tb-set-hardware {node type args} {
global TBCMD nodeid_map
......@@ -27,9 +49,30 @@ proc tb-create-os {label path partition} {
global TBCMD nodeid_map
puts $TBCMD "tb-create-os $label $path $partition"
}
proc tb-set-link-loss {src dst rate} {
proc tb-set-link-loss {srclink args} {
global TBCMD nodeid_map
puts $TBCMD "tb-set-link-loss $nodeid_map($src) $nodeid_map($dst) $rate"
global linkmap prefix
if {[llength $args] == 2} {
set dst [lindex $args 0]
set loss [lindex $args 1]
if {[info exists linkmap($srclink:$dst)]} {
if {[info exists nodeid_map($linkmap($srclink:$dst))]} {
real_set linkname $nodeid_map($linkmap($srclink:$dst))
} else {
real_set linkname $linkmap($srclink:$dst)
}
puts $TBCMD "tb-set-link-loss $prefix-$linkname $loss"
} else {
puts stderr "No link between $srclink and $dst."
exit 1
}
} elseif {[llength $args] == 1} {
set loss [lindex $args 0]
puts $TBCMD "tb-set-link-loss $prefix-$nodeid_map($srclink) $loss"
} else {
puts stderr "tb-set-link-loss takes 2 or 3 parameters."
exit 1
}
}
proc tb-set-lan-loss {lan rate} {
global TBCMD nodeid_map prefix
......
......@@ -3,10 +3,12 @@
proc tb-set-ip {node ip} {}
proc tb-set-ip-interface {src dst ip} {}
proc tb-set-ip-link {src link ip} {}
proc tb-set-ip-lan {src lan ip} {}
proc tb-set-hardware {node type args} {}
proc tb-set-node-os {node os} {}
proc tb-create-os {label path partition} {}
proc tb-set-link-loss {src dst rate} {}
proc tb-set-link-loss {src args} {}
proc tb-set-lan-loss {lan rate} {}
# The following commands are not clearly defined and probably will be
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment